annotate src/lread.c @ 5931:7008ece592cb

(command-line-1): Improve previous change.
author Richard M. Stallman <rms@gnu.org>
date Sat, 12 Feb 1994 20:12:21 +0000
parents 0d02ee7ee659
children 8af8f6b469e1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Lisp parsing and input streams.
692
681c352bbf30 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 675
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1988, 1989,
2961
e94a593c3952 Updated copyright years.
Jim Blandy <jimb@redhat.com>
parents: 2901
diff changeset
3 1993 Free Software Foundation, Inc.
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 This file is part of GNU Emacs.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 GNU Emacs is free software; you can redistribute it and/or modify
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 it under the terms of the GNU General Public License as published by
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
9 the Free Software Foundation; either version 2, or (at your option)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 any later version.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 GNU Emacs is distributed in the hope that it will be useful,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 GNU General Public License for more details.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 along with GNU Emacs; see the file COPYING. If not, write to
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22 #include <stdio.h>
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23 #include <sys/types.h>
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 #include <sys/stat.h>
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25 #include <sys/file.h>
796
465cf9f9153b *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 762
diff changeset
26 #include <ctype.h>
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4482
diff changeset
27 #include <config.h>
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #include "lisp.h"
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 #ifndef standalone
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #include "buffer.h"
4701
05f6a91c2801 Include <paths.h>, not "paths.h".
Roland McGrath <roland@gnu.org>
parents: 4696
diff changeset
32 #include <paths.h>
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33 #include "commands.h"
1591
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
34 #include "keyboard.h"
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
35 #include "termhooks.h"
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
36 #endif
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 #ifdef lint
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39 #include <sys/inode.h>
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 #endif /* lint */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
42 #ifndef X_OK
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 #define X_OK 01
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 #endif
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 #ifdef LISP_FLOAT_TYPE
2781
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2654
diff changeset
47 #ifdef STDC_HEADERS
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2654
diff changeset
48 #include <stdlib.h>
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2654
diff changeset
49 #endif
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
50
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
51 #if 0 /* That is untrue--XINT is used below, and it uses INTBITS.
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
52 What in the world is values.h, anyway? */
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
53 #ifdef MSDOS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
54 /* These are redefined in <values.h> and not used here */
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
55 #undef INTBITS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
56 #undef LONGBITS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
57 #undef SHORTBITS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
58 #endif
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
59 #endif
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
60
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 #include <math.h>
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 #endif /* LISP_FLOAT_TYPE */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
64 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
3625
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
66 Lisp_Object Qascii_character, Qload;
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
67
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
68 extern Lisp_Object Qevent_symbol_element_mask;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70 /* non-zero if inside `load' */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 int load_in_progress;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 /* Search path for files to be loaded. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 Lisp_Object Vload_path;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
76 /* 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>
parents: 2439
diff changeset
77 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>
parents: 2439
diff changeset
78 Lisp_Object Vload_history;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
79
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
80 /* This is useud to build the load history. */
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
81 Lisp_Object Vcurrent_load_list;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
82
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
83 /* List of descriptors now open for Fload. */
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
84 static Lisp_Object load_descriptor_list;
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
85
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 /* File for get_file_char to read from. Use by load */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 static FILE *instream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 /* When nonzero, read conses in pure space */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 static int read_pure;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 /* For use within read-from-string (this reader is non-reentrant!!) */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 static int read_from_string_index;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 static int read_from_string_limit;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 /* Handle unreading and rereading of characters.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 Write READCHAR to read a character,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 UNREAD(c) to unread c to be read again. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 #define READCHAR readchar (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 #define UNREAD(c) unreadchar (readcharfun, c)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 static int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 readchar (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 Lisp_Object tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 register struct buffer *inbuffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 register int c, mpos;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 if (XTYPE (readcharfun) == Lisp_Buffer)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 inbuffer = XBUFFER (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 if (BUF_PT (inbuffer) >= BUF_ZV (inbuffer))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, BUF_PT (inbuffer));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 SET_BUF_PT (inbuffer, BUF_PT (inbuffer) + 1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 return c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 if (XTYPE (readcharfun) == Lisp_Marker)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 inbuffer = XMARKER (readcharfun)->buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 mpos = marker_position (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 if (mpos > BUF_ZV (inbuffer) - 1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, mpos);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 if (mpos != BUF_GPT (inbuffer))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 XMARKER (readcharfun)->bufpos++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 Fset_marker (readcharfun, make_number (mpos + 1),
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 Fmarker_buffer (readcharfun));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 return c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 if (EQ (readcharfun, Qget_file_char))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 return getc (instream);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 if (XTYPE (readcharfun) == Lisp_String)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143 register int c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 /* This used to be return of a conditional expression,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 but that truncated -1 to a char on VMS. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 if (read_from_string_index < read_from_string_limit)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 c = XSTRING (readcharfun)->data[read_from_string_index++];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 c = -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 return c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 tem = call0 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
155 if (NILP (tem))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 return XINT (tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 /* Unread the character C in the way appropriate for the stream READCHARFUN.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 If the stream is a user function, call it with the char as argument. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 static void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164 unreadchar (readcharfun, c)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 int c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 if (XTYPE (readcharfun) == Lisp_Buffer)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 if (XBUFFER (readcharfun) == current_buffer)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 SET_PT (point - 1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 SET_BUF_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 else if (XTYPE (readcharfun) == Lisp_Marker)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 XMARKER (readcharfun)->bufpos--;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 else if (XTYPE (readcharfun) == Lisp_String)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 read_from_string_index--;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 else if (EQ (readcharfun, Qget_file_char))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 ungetc (c, instream);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 call1 (readcharfun, make_number (c));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 /* get a character from the tty */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188
1519
5d0837ebee9c * lread.c (read_char): Add an extern declaration for this,
Jim Blandy <jimb@redhat.com>
parents: 1092
diff changeset
189 extern Lisp_Object read_char ();
5d0837ebee9c * lread.c (read_char): Add an extern declaration for this,
Jim Blandy <jimb@redhat.com>
parents: 1092
diff changeset
190
2654
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
191 /* Read input events until we get one that's acceptable for our purposes.
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
192
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
193 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
194 until we get a character we like, and then stuffed into
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
195 unread_switch_frame.
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
196
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
197 If ASCII_REQUIRED is non-zero, we check function key events to see
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
198 if the unmodified version of the symbol has a Qascii_character
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
199 property, and use that character, if present.
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
200
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
201 If ERROR_NONASCII is non-zero, we signal an error if the input we
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
202 get isn't an ASCII character with modifiers. If it's zero but
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
203 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
204 character. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
205 Lisp_Object
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
206 read_filtered_event (no_switch_frame, ascii_required, error_nonascii)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
207 int no_switch_frame, ascii_required, error_nonascii;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
208 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
209 #ifdef standalone
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
210 return make_number (getchar ());
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
211 #else
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
212 register Lisp_Object val;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
213 register Lisp_Object delayed_switch_frame = Qnil;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
214
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
215 /* Read until we get an acceptable event. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
216 retry:
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
217 val = read_char (0, 0, 0, Qnil, 0);
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
218
5888
0d02ee7ee659 (read_filtered_event): Retry read_char after a buffer change.
Karl Heuer <kwzh@gnu.org>
parents: 5687
diff changeset
219 if (XTYPE (val) == Lisp_Buffer)
0d02ee7ee659 (read_filtered_event): Retry read_char after a buffer change.
Karl Heuer <kwzh@gnu.org>
parents: 5687
diff changeset
220 goto retry;
0d02ee7ee659 (read_filtered_event): Retry read_char after a buffer change.
Karl Heuer <kwzh@gnu.org>
parents: 5687
diff changeset
221
2654
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
222 /* switch-frame events are put off until after the next ASCII
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
223 character. This is better than signalling an error just because
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
224 the last characters were typed to a separate minibuffer frame,
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
225 for example. Eventually, some code which can deal with
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
226 switch-frame events will read it and process it. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
227 if (no_switch_frame
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
228 && EVENT_HAS_PARAMETERS (val)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
229 && EQ (EVENT_HEAD (val), Qswitch_frame))
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
230 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
231 delayed_switch_frame = val;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
232 goto retry;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
233 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
234
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
235 if (ascii_required)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
236 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
237 /* Convert certain symbols to their ASCII equivalents. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
238 if (XTYPE (val) == Lisp_Symbol)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
239 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
240 Lisp_Object tem, tem1, tem2;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
241 tem = Fget (val, Qevent_symbol_element_mask);
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
242 if (!NILP (tem))
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
243 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
244 tem1 = Fget (Fcar (tem), Qascii_character);
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
245 /* Merge this symbol's modifier bits
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
246 with the ASCII equivalent of its basic code. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
247 if (!NILP (tem1))
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
248 XFASTINT (val) = XINT (tem1) | XINT (Fcar (Fcdr (tem)));
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
249 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
250 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
251
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
252 /* If we don't have a character now, deal with it appropriately. */
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
253 if (XTYPE (val) != Lisp_Int)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
254 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
255 if (error_nonascii)
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
256 {
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
257 unread_command_events = Fcons (val, Qnil);
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
258 error ("Non-character input-event");
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
259 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
260 else
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
261 goto retry;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
262 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
263 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
264
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
265 if (! NILP (delayed_switch_frame))
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
266 unread_switch_frame = delayed_switch_frame;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
267
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
268 return val;
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
269 #endif
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
270 }
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
271
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272 DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
273 "Read a character from the command input (keyboard or macro).\n\
851
9620f7edf04d entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 826
diff changeset
274 It is returned as a number.\n\
9620f7edf04d entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 826
diff changeset
275 If the user generates an event which is not a character (i.e. a mouse\n\
1591
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
276 click or function key event), `read-char' signals an error. As an\n\
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
277 exception, switch-frame events are put off until non-ASCII events can\n\
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
278 be read.\n\
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
279 If you want to read non-character events, or ignore them, call\n\
765cb54fa9af * lread.c: #include "keyboard.h".
Jim Blandy <jimb@redhat.com>
parents: 1519
diff changeset
280 `read-event' or `read-char-exclusive' instead.")
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 ()
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 {
2654
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
283 return read_filtered_event (1, 1, 1);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 DEFUN ("read-event", Fread_event, Sread_event, 0, 0, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 "Read an event object from the input stream.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 ()
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 {
2654
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
290 return read_filtered_event (0, 0, 0);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 0, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 "Read a character from the command input (keyboard or macro).\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 It is returned as a number. Non character events are ignored.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 ()
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297 {
2654
ba685dcc3750 Arrange for Fy_or_n_p to put off switch-frame events.
Jim Blandy <jimb@redhat.com>
parents: 2545
diff changeset
298 return read_filtered_event (1, 1, 0);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 "Don't use this yourself.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 ()
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 register Lisp_Object val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306 XSET (val, Lisp_Int, getc (instream));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 static void readevalloop ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 static Lisp_Object load_unwind ();
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
312 static Lisp_Object load_descriptor_unwind ();
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 DEFUN ("load", Fload, Sload, 1, 4, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315 "Execute a file of Lisp code named FILE.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316 First try FILE with `.elc' appended, then try with `.el',\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
317 then try FILE unmodified.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318 This function searches the directories in `load-path'.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 If optional second arg NOERROR is non-nil,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
320 report no error if FILE doesn't exist.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
321 Print messages at start and end of loading unless\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322 optional third arg NOMESSAGE is non-nil.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 suffixes `.elc' or `.el' to the specified name FILE.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
325 Return t if file exists.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
326 (str, noerror, nomessage, nosuffix)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327 Lisp_Object str, noerror, nomessage, nosuffix;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
328 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
329 register FILE *stream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
330 register int fd = -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
331 register Lisp_Object lispstream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 register FILE **ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 int count = specpdl_ptr - specpdl;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 Lisp_Object temp;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
335 struct gcpro gcpro1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336 Lisp_Object found;
1758
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
337 /* 1 means inhibit the message at the beginning. */
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
338 int nomessage1 = 0;
3625
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
339 Lisp_Object handler;
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
340 #ifdef MSDOS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
341 char *dosmode = "rt";
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
342 #endif
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
344 CHECK_STRING (str, 0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
345 str = Fsubstitute_in_file_name (str);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346
3625
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
347 /* If file name is magic, call the handler. */
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
348 handler = Ffind_file_name_handler (str);
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
349 if (!NILP (handler))
3704
8488ad8eb302 (Fload): Use call5.
Richard M. Stallman <rms@gnu.org>
parents: 3625
diff changeset
350 return call5 (handler, Qload, str, noerror, nomessage, nosuffix);
3625
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
351
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 /* Avoid weird lossage with null string as arg,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
353 since it would try to load a directory as a Lisp file */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 if (XSTRING (str)->size > 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
356 fd = openp (Vload_path, str, !NILP (nosuffix) ? "" : ".elc:.el:",
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 &found, 0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 if (fd < 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
362 if (NILP (noerror))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 Fcons (str, Qnil)));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 return Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 if (!bcmp (&(XSTRING (found)->data[XSTRING (found)->size - 4]),
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 ".elc", 4))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373 struct stat s1, s2;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 int result;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
376 #ifdef MSDOS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
377 dosmode = "rb";
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
378 #endif
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 stat (XSTRING (found)->data, &s1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 XSTRING (found)->data[XSTRING (found)->size - 1] = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 result = stat (XSTRING (found)->data, &s2);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1758
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
383 {
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
384 message ("Source file `%s' newer than byte-compiled file",
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
385 XSTRING (found)->data);
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
386 /* Don't immediately overwrite this message. */
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
387 if (!noninteractive)
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
388 nomessage1 = 1;
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
389 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 XSTRING (found)->data[XSTRING (found)->size - 1] = 'c';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
393 #ifdef MSDOS
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
394 close (fd);
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
395 stream = fopen ((char *) XSTRING (found)->data, dosmode);
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
396 #else
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 stream = fdopen (fd, "r");
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
398 #endif
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 if (stream == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 close (fd);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 error ("Failure to create stdio stream for %s", XSTRING (str)->data);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404
1758
12c730b89ac8 (Fload): If warn that .elc file is older,
Richard M. Stallman <rms@gnu.org>
parents: 1591
diff changeset
405 if (NILP (nomessage) && !nomessage1)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 message ("Loading %s...", XSTRING (str)->data);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 GCPRO1 (str);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 /* We may not be able to store STREAM itself as a Lisp_Object pointer
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 since that is guaranteed to work only for data that has been malloc'd.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 So malloc a full-size pointer, and record the address of that pointer. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 ptr = (FILE **) xmalloc (sizeof (FILE *));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 *ptr = stream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 record_unwind_protect (load_unwind, lispstream);
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
416 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
417 load_descriptor_list
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
418 = Fcons (make_number (fileno (stream)), load_descriptor_list);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 load_in_progress++;
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
420 readevalloop (Qget_file_char, stream, str, Feval, 0);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 unbind_to (count, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423 /* Run any load-hooks for this file. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 temp = Fassoc (str, Vafter_load_alist);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
425 if (!NILP (temp))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 Fprogn (Fcdr (temp));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 UNGCPRO;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
429 if (!noninteractive && NILP (nomessage))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 message ("Loading %s...done", XSTRING (str)->data);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 return Qt;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 static Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 load_unwind (stream) /* used as unwind-protect function in load */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
436 Lisp_Object stream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 fclose (*(FILE **) XSTRING (stream));
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2044
diff changeset
439 xfree (XPNTR (stream));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 if (--load_in_progress < 0) load_in_progress = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 return Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
444 static Lisp_Object
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
445 load_descriptor_unwind (oldlist)
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
446 Lisp_Object oldlist;
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
447 {
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
448 load_descriptor_list = oldlist;
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
449 }
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
450
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
451 /* Close all descriptors in use for Floads.
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
452 This is used when starting a subprocess. */
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
453
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
454 void
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
455 close_load_descs ()
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
456 {
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
457 Lisp_Object tail;
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
458 for (tail = load_descriptor_list; !NILP (tail); tail = XCONS (tail)->cdr)
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
459 close (XFASTINT (XCONS (tail)->car));
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
460 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 static int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 complete_filename_p (pathname)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 Lisp_Object pathname;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 register unsigned char *s = XSTRING (pathname)->data;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467 return (*s == '/'
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 #ifdef ALTOS
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 || *s == '@'
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 #endif
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 #ifdef VMS
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 || index (s, ':')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 #endif /* VMS */
5496
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
474 #ifdef MSDOS /* MW, May 1993 */
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
475 || (s[0] != '\0' && s[1] == ':' && s[2] == '/')
24f0d2908e61 [MSDOS]: Use text mode for all files but ".elc" files.
Richard M. Stallman <rms@gnu.org>
parents: 5243
diff changeset
476 #endif
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 );
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 /* Search for a file whose name is STR, looking in directories
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 in the Lisp list PATH, and trying suffixes from SUFFIX.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 SUFFIX is a string containing possible suffixes separated by colons.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 On success, returns a file descriptor. On failure, returns -1.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 EXEC_ONLY nonzero means don't open the files,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 just look for one that is executable. In this case,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 returns 1 on success.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 If STOREPTR is nonzero, it points to a slot where the name of
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 the file actually found should be stored as a Lisp string.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 Nil is stored there on failure. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 openp (path, str, suffix, storeptr, exec_only)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 Lisp_Object path, str;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 char *suffix;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 Lisp_Object *storeptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498 int exec_only;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
500 register int fd;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 int fn_size = 100;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 char buf[100];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 register char *fn = buf;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504 int absolute = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 int want_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 register Lisp_Object filename;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 struct stat st;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 if (storeptr)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 *storeptr = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 if (complete_filename_p (str))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 absolute = 1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
515 for (; !NILP (path); path = Fcdr (path))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 char *nsuffix;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 filename = Fexpand_file_name (str, Fcar (path));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 if (!complete_filename_p (filename))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 /* If there are non-absolute elts in PATH (eg ".") */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 /* Of course, this could conceivably lose if luser sets
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 default-directory to be something non-absolute... */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 filename = Fexpand_file_name (filename, current_buffer->directory);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 if (!complete_filename_p (filename))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 /* Give up on this path element! */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 continue;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531 /* Calculate maximum size of any filename made from
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 this path element/specified file name and any possible suffix. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 want_size = strlen (suffix) + XSTRING (filename)->size + 1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 if (fn_size < want_size)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 fn = (char *) alloca (fn_size = 100 + want_size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 nsuffix = suffix;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 /* Loop over suffixes. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
541 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542 char *esuffix = (char *) index (nsuffix, ':');
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 /* Concatenate path element/specified name with the suffix. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 strncpy (fn, XSTRING (filename)->data, XSTRING (filename)->size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 fn[XSTRING (filename)->size] = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 strncat (fn, nsuffix, lsuffix);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 /* Ignore file if it's a directory. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
552 if (stat (fn, &st) >= 0
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 && (st.st_mode & S_IFMT) != S_IFDIR)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 /* Check that we can access or open it. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556 if (exec_only)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 fd = (access (fn, X_OK) == 0) ? 1 : -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 fd = open (fn, 0, 0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 if (fd >= 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 /* We succeeded; return this descriptor and filename. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 if (storeptr)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 *storeptr = build_string (fn);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 return fd;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 /* Advance to next suffix. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 if (esuffix == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 nsuffix += lsuffix + 1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 if (absolute) return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578 return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
582 /* 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>
parents: 2439
diff changeset
583 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>
parents: 2439
diff changeset
584 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>
parents: 2439
diff changeset
585
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
586 static void
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
587 build_load_history (stream, source)
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
588 FILE *stream;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
589 Lisp_Object source;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
590 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
591 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>
parents: 2439
diff changeset
592 register Lisp_Object tem, tem2;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
593 register int foundit, loading;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
594
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
595 /* Don't bother recording anything for preloaded files. */
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
596 if (!NILP (Vpurify_flag))
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
597 return;
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
598
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
599 loading = stream || !NARROWED;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
600
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
601 tail = Vload_history;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
602 prev = Qnil;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
603 foundit = 0;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
604 while (!NILP (tail))
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
605 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
606 tem = Fcar (tail);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
607
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
608 /* 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>
parents: 2439
diff changeset
609 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>
parents: 2439
diff changeset
610 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
611 foundit = 1;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
612
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
613 /* 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>
parents: 2439
diff changeset
614 if (loading)
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
615 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
616 if (NILP (prev))
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
617 Vload_history = Fcdr (tail);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
618 else
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
619 Fsetcdr (prev, Fcdr (tail));
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
620 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
621
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
622 /* 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>
parents: 2439
diff changeset
623 else
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
624 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
625 tem2 = Vcurrent_load_list;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
626
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
627 while (CONSP (tem2))
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
628 {
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
629 newelt = Fcar (tem2);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
630
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
631 if (NILP (Fmemq (newelt, tem)))
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
632 Fsetcar (tail, Fcons (Fcar (tem),
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
633 Fcons (newelt, Fcdr (tem))));
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
634
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
635 tem2 = Fcdr (tem2);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
636 QUIT;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
637 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
638 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
639 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
640 else
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
641 prev = tail;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
642 tail = Fcdr (tail);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
643 QUIT;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
644 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
645
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
646 /* If we're loading, cons the new assoc onto the front of load-history,
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
647 the most-recently-loaded position. Also do this if we didn't find
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
648 an existing member for the current source. */
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
649 if (loading || !foundit)
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
650 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
651 Vload_history);
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
652 }
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
653
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
654 Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
655 unreadpure () /* Used as unwind-protect function in readevalloop */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 read_pure = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
658 return Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
659 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
660
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
661 static void
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
662 readevalloop (readcharfun, stream, sourcename, evalfun, printflag)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
663 Lisp_Object readcharfun;
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
664 FILE *stream;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
665 Lisp_Object sourcename;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
666 Lisp_Object (*evalfun) ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667 int printflag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
668 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
669 register int c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
670 register Lisp_Object val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
671 int count = specpdl_ptr - specpdl;
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
672 struct gcpro gcpro1;
5185
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
673 struct buffer *b = 0;
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
674
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
675 if (BUFFERP (readcharfun))
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
676 b = XBUFFER (readcharfun);
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
677 else if (MARKERP (readcharfun))
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
678 b = XMARKER (readcharfun)->buffer;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
679
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
680 specbind (Qstandard_input, readcharfun);
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
681 specbind (Qcurrent_load_list, Qnil);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
682
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
683 GCPRO1 (sourcename);
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
684
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
685 LOADHIST_ATTACH (sourcename);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
686
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688 {
5185
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
689 if (b != 0 && NILP (b->name))
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
690 error ("Reading from killed buffer");
52629d087993 (readevalloop): Get error if buffer being eval'd is killed.
Richard M. Stallman <rms@gnu.org>
parents: 5117
diff changeset
691
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
692 instream = stream;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
693 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
694 if (c == ';')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
695 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 while ((c = READCHAR) != '\n' && c != -1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 continue;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 if (c < 0) break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
700 if (c == ' ' || c == '\t' || c == '\n' || c == '\f') continue;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
702 if (!NILP (Vpurify_flag) && c == '(')
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 record_unwind_protect (unreadpure, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705 val = read_list (-1, readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706 unbind_to (count + 1, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
709 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
710 UNREAD (c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 val = read0 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
712 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 val = (*evalfun) (val);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715 if (printflag)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
717 Vvalues = Fcons (val, Vvalues);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 if (EQ (Vstandard_output, Qt))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 Fprin1 (val, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
721 Fprint (val, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
725 build_load_history (stream, sourcename);
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
726 UNGCPRO;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
727
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728 unbind_to (count, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
729 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
730
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
731 #ifndef standalone
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732
732
a8d94735277e *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 692
diff changeset
733 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 2, "",
675
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 673
diff changeset
734 "Execute the current buffer as Lisp code.\n\
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 673
diff changeset
735 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 673
diff changeset
736 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 673
diff changeset
737 PRINTFLAG controls printing of output:\n\
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
738 nil means discard it; anything else is stream for print.\n\
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
739 \n\
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
740 If there is no error, point does not move. If there is an error,\n\
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
741 point remains at the end of the last character read from the buffer.")
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
742 (bufname, printflag)
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
743 Lisp_Object bufname, printflag;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
744 {
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
745 int count = specpdl_ptr - specpdl;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
746 Lisp_Object tem, buf;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
747
673
6217fa6e2cab *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 672
diff changeset
748 if (NILP (bufname))
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
749 buf = Fcurrent_buffer ();
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
750 else
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
751 buf = Fget_buffer (bufname);
673
6217fa6e2cab *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 672
diff changeset
752 if (NILP (buf))
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
753 error ("No such buffer.");
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
754
673
6217fa6e2cab *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 672
diff changeset
755 if (NILP (printflag))
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
756 tem = Qsymbolp;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
757 else
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
758 tem = printflag;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
759 specbind (Qstandard_output, tem);
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
760 record_unwind_protect (save_excursion_restore, save_excursion_save ());
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
761 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
762 readevalloop (buf, 0, XBUFFER (buf)->filename, Feval, !NILP (printflag));
1924
21bd3a2189d3 * keyboard.c (recursive_edit_1, command_loop_1): Pass the proper
Jim Blandy <jimb@redhat.com>
parents: 1887
diff changeset
763 unbind_to (count, Qnil);
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
764
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
765 return Qnil;
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
766 }
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
767
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
768 #if 0
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 DEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "",
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 "Execute the current buffer as Lisp code.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
771 Programs can pass argument PRINTFLAG which controls printing of output:\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 nil means discard it; anything else is stream for print.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
773 \n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
774 If there is no error, point does not move. If there is an error,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775 point remains at the end of the last character read from the buffer.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
776 (printflag)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
777 Lisp_Object printflag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
778 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
779 int count = specpdl_ptr - specpdl;
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
780 Lisp_Object tem, cbuf;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
781
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
782 cbuf = Fcurrent_buffer ()
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
783
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
784 if (NILP (printflag))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
785 tem = Qsymbolp;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
786 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
787 tem = printflag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
788 specbind (Qstandard_output, tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
789 record_unwind_protect (save_excursion_restore, save_excursion_save ());
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
790 SET_PT (BEGV);
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
791 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
792 return unbind_to (count, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
793 }
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
794 #endif
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
795
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
796 DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r",
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
797 "Execute the region as Lisp code.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
798 When called from programs, expects two arguments,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
799 giving starting and ending indices in the current buffer\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
800 of the text to be executed.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
801 Programs can pass third argument PRINTFLAG which controls output:\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
802 nil means discard it; anything else is stream for printing it.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
803 \n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
804 If there is no error, point does not move. If there is an error,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
805 point remains at the end of the last character read from the buffer.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
806 (b, e, printflag)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
807 Lisp_Object b, e, printflag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
808 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
809 int count = specpdl_ptr - specpdl;
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
810 Lisp_Object tem, cbuf;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
811
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
812 cbuf = Fcurrent_buffer ();
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
813
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
814 if (NILP (printflag))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
815 tem = Qsymbolp;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
816 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
817 tem = printflag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
818 specbind (Qstandard_output, tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
820 if (NILP (printflag))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821 record_unwind_protect (save_excursion_restore, save_excursion_save ());
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
822 record_unwind_protect (save_restriction_restore, save_restriction_save ());
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
823
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
824 /* This both uses b and checks its type. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
825 Fgoto_char (b);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
826 Fnarrow_to_region (make_number (BEGV), e);
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
827 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 return unbind_to (count, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
830 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
832 #endif /* standalone */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
833
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
834 DEFUN ("read", Fread, Sread, 0, 1, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
835 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836 If STREAM is nil, use the value of `standard-input' (which see).\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
837 STREAM or the value of `standard-input' may be:\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
838 a buffer (read from point and advance it)\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
839 a marker (read from where it points and advance it)\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
840 a function (call it with no arguments for each character,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841 call it with a char as argument to push a char back)\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
842 a string (takes text from string, starting at the beginning)\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
843 t (read text line using minibuffer and use it).")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
844 (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
845 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
846 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
847 extern Lisp_Object Fread_minibuffer ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
848
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
849 if (NILP (readcharfun))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
850 readcharfun = Vstandard_input;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851 if (EQ (readcharfun, Qt))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
852 readcharfun = Qread_char;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
853
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
854 #ifndef standalone
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
855 if (EQ (readcharfun, Qread_char))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
856 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
857 #endif
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
858
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 if (XTYPE (readcharfun) == Lisp_String)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
860 return Fcar (Fread_from_string (readcharfun, Qnil, Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
861
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
862 return read0 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
863 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
864
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
865 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
866 "Read one Lisp expression which is represented as text by STRING.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
867 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
868 START and END optionally delimit a substring of STRING from which to read;\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
869 they default to 0 and (length STRING) respectively.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
870 (string, start, end)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
871 Lisp_Object string, start, end;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
872 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873 int startval, endval;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
874 Lisp_Object tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
875
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
876 CHECK_STRING (string,0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
877
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
878 if (NILP (end))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
879 endval = XSTRING (string)->size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
880 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
881 { CHECK_NUMBER (end,2);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
882 endval = XINT (end);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
883 if (endval < 0 || endval > XSTRING (string)->size)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
884 args_out_of_range (string, end);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
885 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
886
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
887 if (NILP (start))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
888 startval = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
889 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
890 { CHECK_NUMBER (start,1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
891 startval = XINT (start);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
892 if (startval < 0 || startval > endval)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
893 args_out_of_range (string, start);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
895
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
896 read_from_string_index = startval;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
897 read_from_string_limit = endval;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
898
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
899 tem = read0 (string);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
900 return Fcons (tem, make_number (read_from_string_index));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
901 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
902
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
903 /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
904
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
905 static Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
906 read0 (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
907 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
908 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
909 register Lisp_Object val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
910 char c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
911
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
912 val = read1 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
913 if (XTYPE (val) == Lisp_Internal)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
914 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
915 c = XINT (val);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
916 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
917 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
918
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
920 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
921
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
922 static int read_buffer_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 static char *read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
924
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
925 static int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
926 read_escape (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
928 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
929 register int c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
930 switch (c)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
931 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
932 case 'a':
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
933 return '\007';
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
934 case 'b':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
935 return '\b';
2018
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
936 case 'd':
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
937 return 0177;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
938 case 'e':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
939 return 033;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
940 case 'f':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
941 return '\f';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
942 case 'n':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
943 return '\n';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
944 case 'r':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
945 return '\r';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
946 case 't':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
947 return '\t';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
948 case 'v':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
949 return '\v';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
950 case '\n':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
951 return -1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
952
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
953 case 'M':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
954 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
955 if (c != '-')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
956 error ("Invalid escape character syntax");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
957 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
958 if (c == '\\')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
959 c = read_escape (readcharfun);
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
960 return c | meta_modifier;
2018
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
961
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
962 case 'S':
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
963 c = READCHAR;
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
964 if (c != '-')
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
965 error ("Invalid escape character syntax");
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
966 c = READCHAR;
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
967 if (c == '\\')
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
968 c = read_escape (readcharfun);
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
969 return c | shift_modifier;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
970
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
971 case 'H':
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
972 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
973 if (c != '-')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
974 error ("Invalid escape character syntax");
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
975 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
976 if (c == '\\')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
977 c = read_escape (readcharfun);
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
978 return c | hyper_modifier;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
979
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
980 case 'A':
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
981 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
982 if (c != '-')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
983 error ("Invalid escape character syntax");
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
984 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
985 if (c == '\\')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
986 c = read_escape (readcharfun);
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
987 return c | alt_modifier;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
988
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
989 case 's':
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
990 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
991 if (c != '-')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
992 error ("Invalid escape character syntax");
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
993 c = READCHAR;
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
994 if (c == '\\')
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
995 c = read_escape (readcharfun);
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
996 return c | super_modifier;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
997
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
998 case 'C':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
999 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1000 if (c != '-')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1001 error ("Invalid escape character syntax");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1002 case '^':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1003 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1004 if (c == '\\')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1005 c = read_escape (readcharfun);
2018
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1006 if ((c & 0177) == '?')
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1007 return 0177 | c;
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1008 /* ASCII control chars are made from letters (both cases),
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1009 as well as the non-letters within 0100...0137. */
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1010 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1011 return (c & (037 | ~0177));
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1012 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1013 return (c & (037 | ~0177));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1014 else
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
1015 return c | ctrl_modifier;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1016
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1017 case '0':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1018 case '1':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1019 case '2':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1020 case '3':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1021 case '4':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1022 case '5':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1023 case '6':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1024 case '7':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1025 /* An octal escape, as in ANSI C. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1026 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1027 register int i = c - '0';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1028 register int count = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1029 while (++count < 3)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1030 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1031 if ((c = READCHAR) >= '0' && c <= '7')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1032 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1033 i *= 8;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1034 i += c - '0';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1035 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1036 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1037 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1038 UNREAD (c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039 break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1042 return i;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1043 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 case 'x':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1046 /* A hex escape, as in ANSI C. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 int i = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1051 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1052 if (c >= '0' && c <= '9')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 i *= 16;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1055 i += c - '0';
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 else if ((c >= 'a' && c <= 'f')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 || (c >= 'A' && c <= 'F'))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1060 i *= 16;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1061 if (c >= 'a' && c <= 'f')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1062 i += c - 'a' + 10;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1063 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1064 i += c - 'A' + 10;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1065 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1066 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1067 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1068 UNREAD (c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1069 break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1070 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1071 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1072 return i;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1073 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1074
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1075 default:
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1076 return c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1077 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1079
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1080 static Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1081 read1 (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1082 register Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1083 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1084 register int c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1085
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1086 retry:
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1087
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1088 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1089 if (c < 0) return Fsignal (Qend_of_file, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1090
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1091 switch (c)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1092 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1093 case '(':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1094 return read_list (0, readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1095
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1096 case '[':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1097 return read_vector (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1098
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 case ')':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100 case ']':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1102 register Lisp_Object val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1103 XSET (val, Lisp_Internal, c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1104 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1105 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1106
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1107 case '#':
373
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1108 c = READCHAR;
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1109 if (c == '[')
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1110 {
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1111 /* Accept compiled functions at read-time so that we don't have to
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1112 build them using function calls. */
1966
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1113 Lisp_Object tmp;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1114 tmp = read_vector (readcharfun);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1115 return Fmake_byte_code (XVECTOR (tmp)->size,
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1116 XVECTOR (tmp)->contents);
373
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1117 }
1966
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1118 #ifdef USE_TEXT_PROPERTIES
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1119 if (c == '(')
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1120 {
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1121 Lisp_Object tmp;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1122 struct gcpro gcpro1;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1123
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1124 /* Read the string itself. */
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1125 tmp = read1 (readcharfun);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1126 if (XTYPE (tmp) != Lisp_String)
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1127 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1128 GCPRO1 (tmp);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1129 /* Read the intervals and their properties. */
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1130 while (1)
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1131 {
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1132 Lisp_Object beg, end, plist;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1133
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1134 beg = read1 (readcharfun);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1135 if (XTYPE (beg) == Lisp_Internal)
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1136 {
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1137 if (XINT (beg) == ')')
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1138 break;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1139 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil));
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1140 }
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1141 end = read1 (readcharfun);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1142 if (XTYPE (end) == Lisp_Internal)
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1143 Fsignal (Qinvalid_read_syntax,
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1144 Fcons (make_string ("invalid string property list", 28), Qnil));
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1145
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1146 plist = read1 (readcharfun);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1147 if (XTYPE (plist) == Lisp_Internal)
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1148 Fsignal (Qinvalid_read_syntax,
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1149 Fcons (make_string ("invalid string property list", 28), Qnil));
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1150 Fset_text_properties (beg, end, plist, tmp);
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1151 }
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1152 UNGCPRO;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1153 return tmp;
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1154 }
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1155 #endif
373
7c6f74ef31a3 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 364
diff changeset
1156 UNREAD (c);
1966
bcc34323a475 (read1--strings with properties case):
Richard M. Stallman <rms@gnu.org>
parents: 1924
diff changeset
1157 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1158
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1159 case ';':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1160 while ((c = READCHAR) >= 0 && c != '\n');
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1161 goto retry;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1162
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1163 case '\'':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1164 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1165 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1166 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1167
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1168 case '?':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1169 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1170 register Lisp_Object val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1171
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1172 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1173 if (c < 0) return Fsignal (Qend_of_file, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1174
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1175 if (c == '\\')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1176 XSET (val, Lisp_Int, read_escape (readcharfun));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1177 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1178 XSET (val, Lisp_Int, c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1179
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1180 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1181 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1182
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1183 case '\"':
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1184 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1185 register char *p = read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1186 register char *end = read_buffer + read_buffer_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1187 register int c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1188 int cancel = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1189
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1190 while ((c = READCHAR) >= 0
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1191 && c != '\"')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1192 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1193 if (p == end)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1194 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1195 char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1196 p += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1197 read_buffer += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198 end = read_buffer + read_buffer_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1199 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1200 if (c == '\\')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1201 c = read_escape (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202 /* c is -1 if \ newline has just been seen */
2018
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1203 if (c == -1)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1204 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1205 if (p == read_buffer)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1206 cancel = 1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1207 }
2018
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1208 else if (c & CHAR_META)
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1209 /* Move the meta bit to the right place for a string. */
7c970ef8949d (read_escape): Handle M-, C- and S- for new convention.
Richard M. Stallman <rms@gnu.org>
parents: 1966
diff changeset
1210 *p++ = (c & ~CHAR_META) | 0x80;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 *p++ = c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1214 if (c < 0) return Fsignal (Qend_of_file, Qnil);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216 /* If purifying, and string starts with \ newline,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1217 return zero instead. This is for doc strings
604
63a8e7b3c547 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1218 that we are really going to find in etc/DOC.nn.nn */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1219 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1220 return make_number (0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1221
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1222 if (read_pure)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1223 return make_pure_string (read_buffer, p - read_buffer);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1224 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1225 return make_string (read_buffer, p - read_buffer);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1226 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1227
762
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1228 case '.':
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1229 {
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1230 #ifdef LISP_FLOAT_TYPE
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1231 /* If a period is followed by a number, then we should read it
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1232 as a floating point number. Otherwise, it denotes a dotted
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1233 pair. */
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1234 int next_char = READCHAR;
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1235 UNREAD (next_char);
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1236
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1237 if (! isdigit (next_char))
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1238 #endif
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1239 {
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1240 register Lisp_Object val;
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1241 XSET (val, Lisp_Internal, c);
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1242 return val;
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1243 }
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1244
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1245 /* Otherwise, we fall through! Note that the atom-reading loop
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1246 below will now loop at least once, assuring that we will not
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1247 try to UNREAD two characters in a row. */
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1248 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1249 default:
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1250 if (c <= 040) goto retry;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1251 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1252 register char *p = read_buffer;
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1253 int quoted = 0;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1254
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1255 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1256 register char *end = read_buffer + read_buffer_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1257
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258 while (c > 040 &&
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 !(c == '\"' || c == '\'' || c == ';' || c == '?'
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260 || c == '(' || c == ')'
762
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1261 #ifndef LISP_FLOAT_TYPE
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1262 /* If we have floating-point support, then we need
852a2f5838da *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 732
diff changeset
1263 to allow <digits><dot><digits>. */
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1264 || c =='.'
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1265 #endif /* not LISP_FLOAT_TYPE */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266 || c == '[' || c == ']' || c == '#'
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1267 ))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1268 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1269 if (p == end)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1270 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1271 register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1272 p += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1273 read_buffer += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1274 end = read_buffer + read_buffer_size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1275 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1276 if (c == '\\')
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1277 {
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1278 c = READCHAR;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1279 quoted = 1;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1280 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 *p++ = c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282 c = READCHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1283 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1284
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1285 if (p == end)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1286 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287 char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1288 p += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1289 read_buffer += new - read_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1290 /* end = read_buffer + read_buffer_size; */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1292 *p = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1293 if (c >= 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1294 UNREAD (c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1295 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1296
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1297 if (!quoted)
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1298 {
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1299 register char *p1;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1300 register Lisp_Object val;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1301 p1 = read_buffer;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1302 if (*p1 == '+' || *p1 == '-') p1++;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1303 /* Is it an integer? */
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1304 if (p1 != p)
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1305 {
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1306 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1758
diff changeset
1307 #ifdef LISP_FLOAT_TYPE
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1308 /* Integers can have trailing decimal points. */
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1309 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1758
diff changeset
1310 #endif
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1311 if (p1 == p)
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1312 /* It is an integer. */
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1313 {
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1758
diff changeset
1314 #ifdef LISP_FLOAT_TYPE
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1315 if (p1[-1] == '.')
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1316 p1[-1] = '\0';
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1758
diff changeset
1317 #endif
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1318 XSET (val, Lisp_Int, atoi (read_buffer));
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1319 return val;
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1320 }
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1321 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1322 #ifdef LISP_FLOAT_TYPE
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1323 if (isfloat_string (read_buffer))
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1324 return make_float (atof (read_buffer));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 #endif
5017
9c277d938ccd (read1): If token has a \, don't treat it as a number.
Richard M. Stallman <rms@gnu.org>
parents: 4701
diff changeset
1326 }
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 return intern (read_buffer);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1329 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1330 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1331 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1333 #ifdef LISP_FLOAT_TYPE
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1334
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1335 #define LEAD_INT 1
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1336 #define DOT_CHAR 2
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1337 #define TRAIL_INT 4
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1338 #define E_CHAR 8
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1339 #define EXP_INT 16
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1340
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1341 int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1342 isfloat_string (cp)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1343 register char *cp;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1344 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1345 register state;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1346
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 state = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 if (*cp == '+' || *cp == '-')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1350
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1351 if (isdigit(*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1352 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353 state |= LEAD_INT;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 while (isdigit (*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1355 cp ++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 if (*cp == '.')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359 state |= DOT_CHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1360 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1361 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 if (isdigit(*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 state |= TRAIL_INT;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1365 while (isdigit (*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1367 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1368 if (*cp == 'e')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1369 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1370 state |= E_CHAR;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1371 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1372 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1373 if ((*cp == '+') || (*cp == '-'))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1374 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376 if (isdigit (*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1377 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1378 state |= EXP_INT;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1379 while (isdigit (*cp))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1380 cp++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1381 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1382 return (*cp == 0
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1383 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
826
e9b9a1cff2c9 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 796
diff changeset
1384 || state == (DOT_CHAR|TRAIL_INT)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1385 || state == (LEAD_INT|E_CHAR|EXP_INT)
826
e9b9a1cff2c9 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 796
diff changeset
1386 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
e9b9a1cff2c9 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 796
diff changeset
1387 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1388 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1389 #endif /* LISP_FLOAT_TYPE */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1390
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 static Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1392 read_vector (readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1393 Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1394 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1395 register int i;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396 register int size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1397 register Lisp_Object *ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1398 register Lisp_Object tem, vector;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399 register struct Lisp_Cons *otem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1400 Lisp_Object len;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1401
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1402 tem = read_list (1, readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1403 len = Flength (tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1404 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1405
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1407 size = XVECTOR (vector)->size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1408 ptr = XVECTOR (vector)->contents;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1409 for (i = 0; i < size; i++)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1410 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411 ptr[i] = read_pure ? Fpurecopy (Fcar (tem)) : Fcar (tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 otem = XCONS (tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 tem = Fcdr (tem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 free_cons (otem);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1415 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 return vector;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 /* flag = 1 means check for ] to terminate rather than ) and .
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420 flag = -1 means check for starting with defun
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 and make structure pure. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 static Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424 read_list (flag, readcharfun)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 int flag;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1426 register Lisp_Object readcharfun;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1427 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428 /* -1 means check next element for defun,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 0 means don't check,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 1 means already checked and found defun. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 int defunflag = flag < 0 ? -1 : 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1432 Lisp_Object val, tail;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433 register Lisp_Object elt, tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 struct gcpro gcpro1, gcpro2;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 val = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1437 tail = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1439 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1441 GCPRO2 (val, tail);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1442 elt = read1 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1443 UNGCPRO;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1444 if (XTYPE (elt) == Lisp_Internal)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1445 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1446 if (flag > 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1448 if (XINT (elt) == ']')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1449 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1450 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (") or . in a vector", 18), Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1451 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1452 if (XINT (elt) == ')')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1453 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1454 if (XINT (elt) == '.')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1455 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456 GCPRO2 (val, tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1457 if (!NILP (tail))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1458 XCONS (tail)->cdr = read0 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1459 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1460 val = read0 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1461 elt = read1 (readcharfun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 UNGCPRO;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1463 if (XTYPE (elt) == Lisp_Internal && XINT (elt) == ')')
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1464 return val;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1465 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1466 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1469 tem = (read_pure && flag <= 0
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1470 ? pure_cons (elt, Qnil)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1471 : Fcons (elt, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1472 if (!NILP (tail))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473 XCONS (tail)->cdr = tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1474 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1475 val = tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1476 tail = tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1477 if (defunflag < 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1478 defunflag = EQ (elt, Qdefun);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1479 else if (defunflag > 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1480 read_pure = 1;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1481 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1482 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1483
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1484 Lisp_Object Vobarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1485 Lisp_Object initial_obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1486
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1487 Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1488 check_obarray (obarray)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1489 Lisp_Object obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1490 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1491 while (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1492 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1493 /* If Vobarray is now invalid, force it to be valid. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1495
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1496 obarray = wrong_type_argument (Qvectorp, obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1497 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1498 return obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1499 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1500
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501 static int hash_string ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1502 Lisp_Object oblookup ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1504 Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1505 intern (str)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1506 char *str;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1507 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 Lisp_Object tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 int len = strlen (str);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510 Lisp_Object obarray = Vobarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1511
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 if (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 obarray = check_obarray (obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1514 tem = oblookup (obarray, str, len);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515 if (XTYPE (tem) == Lisp_Symbol)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1516 return tem;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1517 return Fintern ((!NILP (Vpurify_flag)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1518 ? make_pure_string (str, len)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1519 : make_string (str, len)),
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1520 obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1521 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1522
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1524 "Return the canonical symbol whose name is STRING.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1525 If there is none, one is created by this function and returned.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526 A second optional argument specifies the obarray to use;\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1527 it defaults to the value of `obarray'.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 (str, obarray)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1529 Lisp_Object str, obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1530 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1531 register Lisp_Object tem, sym, *ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1532
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1533 if (NILP (obarray)) obarray = Vobarray;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1534 obarray = check_obarray (obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1535
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1536 CHECK_STRING (str, 0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1537
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1538 tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539 if (XTYPE (tem) != Lisp_Int)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 return tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1541
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1542 if (!NILP (Vpurify_flag))
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 str = Fpurecopy (str);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 sym = Fmake_symbol (str);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1547 if (XTYPE (*ptr) == Lisp_Symbol)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 XSYMBOL (sym)->next = XSYMBOL (*ptr);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 else
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 XSYMBOL (sym)->next = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1551 *ptr = sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1552 return sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1553 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1554
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1555 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1556 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557 A second optional argument specifies the obarray to use;\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558 it defaults to the value of `obarray'.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 (str, obarray)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560 Lisp_Object str, obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1561 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1562 register Lisp_Object tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1563
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1564 if (NILP (obarray)) obarray = Vobarray;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565 obarray = check_obarray (obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1566
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 CHECK_STRING (str, 0);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1568
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 tem = oblookup (obarray, XSTRING (str)->data, XSTRING (str)->size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1570 if (XTYPE (tem) != Lisp_Int)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1571 return tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1572 return Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1573 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1574
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575 Lisp_Object
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1576 oblookup (obarray, ptr, size)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1577 Lisp_Object obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1578 register char *ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1579 register int size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1580 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1581 int hash, obsize;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1582 register Lisp_Object tail;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1583 Lisp_Object bucket, tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1584
5243
13cce14b5a0c Line breaking change.
Richard M. Stallman <rms@gnu.org>
parents: 5185
diff changeset
1585 if (XTYPE (obarray) != Lisp_Vector
13cce14b5a0c Line breaking change.
Richard M. Stallman <rms@gnu.org>
parents: 5185
diff changeset
1586 || (obsize = XVECTOR (obarray)->size) == 0)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1587 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1588 obarray = check_obarray (obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1589 obsize = XVECTOR (obarray)->size;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1590 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1591 /* Combining next two lines breaks VMS C 2.3. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1592 hash = hash_string (ptr, size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1593 hash %= obsize;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1594 bucket = XVECTOR (obarray)->contents[hash];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1595 if (XFASTINT (bucket) == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1596 ;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1597 else if (XTYPE (bucket) != Lisp_Symbol)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1598 error ("Bad data in guts of obarray"); /* Like CADR error message */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1599 else for (tail = bucket; ; XSET (tail, Lisp_Symbol, XSYMBOL (tail)->next))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1600 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1601 if (XSYMBOL (tail)->name->size == size &&
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1602 !bcmp (XSYMBOL (tail)->name->data, ptr, size))
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1603 return tail;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1604 else if (XSYMBOL (tail)->next == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1605 break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1606 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1607 XSET (tem, Lisp_Int, hash);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1608 return tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1609 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1610
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1611 static int
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1612 hash_string (ptr, len)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1613 unsigned char *ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1614 int len;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1615 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1616 register unsigned char *p = ptr;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1617 register unsigned char *end = p + len;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1618 register unsigned char c;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1619 register int hash = 0;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1620
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1621 while (p != end)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1622 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1623 c = *p++;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 if (c >= 0140) c -= 40;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1625 hash = ((hash<<3) + (hash>>28) + c);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1626 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 return hash & 07777777777;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1630 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 map_obarray (obarray, fn, arg)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632 Lisp_Object obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 int (*fn) ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 Lisp_Object arg;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1635 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636 register int i;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637 register Lisp_Object tail;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 CHECK_VECTOR (obarray, 1);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1641 tail = XVECTOR (obarray)->contents[i];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1642 if (XFASTINT (tail) != 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1643 while (1)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1644 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1645 (*fn) (tail, arg);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1646 if (XSYMBOL (tail)->next == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1647 break;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1648 XSET (tail, Lisp_Symbol, XSYMBOL (tail)->next);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1649 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1650 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1651 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1652
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1653 mapatoms_1 (sym, function)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1654 Lisp_Object sym, function;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1655 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1656 call1 (function, sym);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1657 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1658
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1659 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1660 "Call FUNCTION on every symbol in OBARRAY.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1661 OBARRAY defaults to the value of `obarray'.")
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1662 (function, obarray)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1663 Lisp_Object function, obarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1664 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665 Lisp_Object tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1666
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 463
diff changeset
1667 if (NILP (obarray)) obarray = Vobarray;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1668 obarray = check_obarray (obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 map_obarray (obarray, mapatoms_1, function);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1671 return Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1672 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1673
5117
951396781a0e (OBARRAY_SIZE): Increase from 509.
Richard M. Stallman <rms@gnu.org>
parents: 5017
diff changeset
1674 #define OBARRAY_SIZE 1511
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1675
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1677 init_obarray ()
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1679 Lisp_Object oblength;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1680 int hash;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1681 Lisp_Object *tem;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1682
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683 XFASTINT (oblength) = OBARRAY_SIZE;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1684
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1685 Qnil = Fmake_symbol (make_pure_string ("nil", 3));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1686 Vobarray = Fmake_vector (oblength, make_number (0));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687 initial_obarray = Vobarray;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1688 staticpro (&initial_obarray);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1689 /* Intern nil in the obarray */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 /* These locals are to kludge around a pyramid compiler bug. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 hash = hash_string ("nil", 3);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1692 /* Separate statement here to avoid VAXC bug. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1693 hash %= OBARRAY_SIZE;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1694 tem = &XVECTOR (Vobarray)->contents[hash];
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1695 *tem = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1696
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1697 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7));
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1698 XSYMBOL (Qnil)->function = Qunbound;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1699 XSYMBOL (Qunbound)->value = Qunbound;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700 XSYMBOL (Qunbound)->function = Qunbound;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1702 Qt = intern ("t");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1703 XSYMBOL (Qnil)->value = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1704 XSYMBOL (Qnil)->plist = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1705 XSYMBOL (Qt)->value = Qt;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1708 Vpurify_flag = Qt;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1709
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710 Qvariable_documentation = intern ("variable-documentation");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1712 read_buffer_size = 100;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 read_buffer = (char *) malloc (read_buffer_size);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1715
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 defsubr (sname)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718 struct Lisp_Subr *sname;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 sym = intern (sname->symbol_name);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 XSET (XSYMBOL (sym)->function, Lisp_Subr, sname);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1724
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1725 #ifdef NOTDEF /* use fset in subr.el now */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1726 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1727 defalias (sname, string)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 struct Lisp_Subr *sname;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1729 char *string;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1730 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1731 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1732 sym = intern (string);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1733 XSET (XSYMBOL (sym)->function, Lisp_Subr, sname);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1734 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1735 #endif /* NOTDEF */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1737 /* New replacement for DefIntVar; it ignores the doc string argument
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1738 on the assumption that make-docfile will handle that. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739 /* Define an "integer variable"; a symbol whose value is forwarded
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1740 to a C variable of type int. Sample call: */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744 defvar_int (namestring, address, doc)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745 char *namestring;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1746 int *address;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1747 char *doc;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1749 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1750 sym = intern (namestring);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1751 XSET (XSYMBOL (sym)->value, Lisp_Intfwd, address);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1752 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1753
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754 /* Similar but define a variable whose value is T if address contains 1,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 NIL if address contains 0 */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 defvar_bool (namestring, address, doc)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759 char *namestring;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 int *address;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761 char *doc;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 sym = intern (namestring);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 XSET (XSYMBOL (sym)->value, Lisp_Boolfwd, address);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 /* Similar but define a variable whose value is the Lisp Object stored at address. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1769
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1770 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1771 defvar_lisp (namestring, address, doc)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 char *namestring;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 Lisp_Object *address;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1774 char *doc;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1775 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1776 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1777 sym = intern (namestring);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 XSET (XSYMBOL (sym)->value, Lisp_Objfwd, address);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779 staticpro (address);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1780 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1781
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1782 /* Similar but don't request gc-marking of the C variable.
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1783 Used when that variable will be gc-marked for some other reason,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 since marking the same slot twice can cause trouble with strings. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 void
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1787 defvar_lisp_nopro (namestring, address, doc)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788 char *namestring;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1789 Lisp_Object *address;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790 char *doc;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 sym = intern (namestring);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 XSET (XSYMBOL (sym)->value, Lisp_Objfwd, address);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 #ifndef standalone
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 /* Similar but define a variable whose value is the Lisp Object stored in
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 the current buffer. address is the address of the slot in the buffer that is current now. */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 void
1009
bf78b5ea9b3a * lread.c (defvar_per_buffer): Support new TYPE argument, by
Jim Blandy <jimb@redhat.com>
parents: 851
diff changeset
1803 defvar_per_buffer (namestring, address, type, doc)
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1804 char *namestring;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1805 Lisp_Object *address;
1009
bf78b5ea9b3a * lread.c (defvar_per_buffer): Support new TYPE argument, by
Jim Blandy <jimb@redhat.com>
parents: 851
diff changeset
1806 Lisp_Object type;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807 char *doc;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809 Lisp_Object sym;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1810 int offset;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1811 extern struct buffer buffer_local_symbols;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1812
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813 sym = intern (namestring);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1814 offset = (char *)address - (char *)current_buffer;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1815
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1816 XSET (XSYMBOL (sym)->value, Lisp_Buffer_Objfwd,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1817 (Lisp_Object *) offset);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1818 *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym;
1009
bf78b5ea9b3a * lread.c (defvar_per_buffer): Support new TYPE argument, by
Jim Blandy <jimb@redhat.com>
parents: 851
diff changeset
1819 *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1820 if (*(int *)(offset + (char *)&buffer_local_flags) == 0)
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1821 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1822 slot of buffer_local_flags */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823 abort ();
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1824 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1825
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1826 #endif /* standalone */
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1827
364
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1828 init_lread ()
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1829 {
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1830 char *normal;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1831
364
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1832 /* Compute the default load-path. */
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1833 #ifdef CANNOT_DUMP
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1834 normal = PATH_LOADSEARCH;
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 621
diff changeset
1835 Vload_path = decode_env_path (0, normal);
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1836 #else
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1837 if (NILP (Vpurify_flag))
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1838 normal = PATH_LOADSEARCH;
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1839 else
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1840 normal = PATH_DUMPLOADSEARCH;
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1841
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1842 /* In a dumped Emacs, we normally have to reset the value of
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1843 Vload_path from PATH_LOADSEARCH, since the value that was dumped
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1844 uses ../lisp, instead of the path of the installed elisp
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1845 libraries. However, if it appears that Vload_path was changed
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1846 from the default before dumping, don't override that value. */
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1847 if (initialized)
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1848 {
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1849 Lisp_Object dump_path;
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1850
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 621
diff changeset
1851 dump_path = decode_env_path (0, PATH_DUMPLOADSEARCH);
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1852 if (! NILP (Fequal (dump_path, Vload_path)))
4482
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1853 {
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1854 Vload_path = decode_env_path (0, normal);
5617
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1855 if (!NILP (Vinstallation_directory))
4482
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1856 {
5617
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1857 /* Add to the path the lisp subdir of the
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1858 installation dir. */
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1859 Lisp_Object tem;
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1860 tem = Fexpand_file_name (build_string ("lisp"),
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1861 Vinstallation_directory);
0b312b3fa24e (init_lread): Use Vinstallation_directory.
Richard M. Stallman <rms@gnu.org>
parents: 5568
diff changeset
1862 if (NILP (Fmember (tem, Vload_path)))
4482
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1863 Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1864 }
09d0f4b26641 (init_lread): Normally put Vinvocation_directory
Richard M. Stallman <rms@gnu.org>
parents: 3704
diff changeset
1865 }
621
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1866 }
eca8812e61cd *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 617
diff changeset
1867 else
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 621
diff changeset
1868 Vload_path = decode_env_path (0, normal);
364
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1869 #endif
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1870
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1871 /* Warn if dirs in the *standard* path don't exist. */
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1872 {
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1873 Lisp_Object path_tail;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1874
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1875 for (path_tail = Vload_path;
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1876 !NILP (path_tail);
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1877 path_tail = XCONS (path_tail)->cdr)
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1878 {
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1879 Lisp_Object dirfile;
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1880 dirfile = Fcar (path_tail);
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1881 if (XTYPE (dirfile) == Lisp_String)
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1882 {
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1883 dirfile = Fdirectory_file_name (dirfile);
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1884 if (access (XSTRING (dirfile)->data, 0) < 0)
5687
2f22c0c6f021 (init_lread): Put non-ex-dir warnings on stderr.
Richard M. Stallman <rms@gnu.org>
parents: 5617
diff changeset
1885 fprintf (stderr, "Warning: lisp library (%s) does not exist.\n",
2f22c0c6f021 (init_lread): Put non-ex-dir warnings on stderr.
Richard M. Stallman <rms@gnu.org>
parents: 5617
diff changeset
1886 XSTRING (Fcar (path_tail))->data);
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1887 }
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1888 }
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1889 }
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1890
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1891 /* If the EMACSLOADPATH environment variable is set, use its value.
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1892 This doesn't apply if we're dumping. */
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1893 if (NILP (Vpurify_flag)
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 604
diff changeset
1894 && egetenv ("EMACSLOADPATH"))
364
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1895 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1896
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1897 Vvalues = Qnil;
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1898
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1899 load_in_progress = 0;
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
1900
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
1901 load_descriptor_list = Qnil;
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1902 }
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1904 void
364
f4767dc8fff4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 341
diff changeset
1905 syms_of_lread ()
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906 {
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1907 defsubr (&Sread);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1908 defsubr (&Sread_from_string);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1909 defsubr (&Sintern);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1910 defsubr (&Sintern_soft);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1911 defsubr (&Sload);
672
f81a3cf6ec22 *** empty log message ***
Joseph Arceneaux <jla@gnu.org>
parents: 638
diff changeset
1912 defsubr (&Seval_buffer);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1913 defsubr (&Seval_region);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1914 defsubr (&Sread_char);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1915 defsubr (&Sread_char_exclusive);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1916 defsubr (&Sread_event);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1917 defsubr (&Sget_file_char);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1918 defsubr (&Smapatoms);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1919
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1920 DEFVAR_LISP ("obarray", &Vobarray,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1921 "Symbol table for use by `intern' and `read'.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1922 It is a vector whose length ought to be prime for best results.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923 The vector's contents don't make sense if examined from Lisp programs;\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924 to find all the symbols in an obarray, use `mapatoms'.");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1926 DEFVAR_LISP ("values", &Vvalues,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1927 "List of values of all expressions which were read, evaluated and printed.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1928 Order is reverse chronological.");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1929
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 DEFVAR_LISP ("standard-input", &Vstandard_input,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931 "Stream for read to get input from.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1932 See documentation of `read' for possible values.");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1933 Vstandard_input = Qt;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1934
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1935 DEFVAR_LISP ("load-path", &Vload_path,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1936 "*List of directories to search for files to load.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1937 Each element is a string (directory name) or nil (try default directory).\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1938 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1887
ab56990c27c4 (syms_of_lread): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1827
diff changeset
1939 otherwise to default specified by file `paths.h' when Emacs was built.");
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1940
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 "Non-nil iff inside of `load'.");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1945 "An alist of expressions to be evalled when particular files are loaded.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 Each element looks like (FILENAME FORMS...).\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1947 When `load' is run and the file-name argument is FILENAME,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948 the FORMS in the corresponding element are executed at the end of loading.\n\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950 with no directory specified, since that is how `load' is normally called.\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 An error in FORMS does not undo the load,\n\
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 but does prevent execution of the rest of the FORMS.");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 Vafter_load_alist = Qnil;
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954
2545
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1955 DEFVAR_LISP ("load-history", &Vload_history,
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1956 "Alist mapping source file names to symbols and features.\n\
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1957 Each alist element is a list that starts with a file name,\n\
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1958 except for one element (optional) that starts with nil and describes\n\
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1959 definitions evaluated from buffers not visiting files.\n\
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1960 The remaining elements of each list are symbols defined as functions\n\
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1961 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1962 Vload_history = Qnil;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1963
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
1964 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
1965 "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>
parents: 2439
diff changeset
1966 Vcurrent_load_list = Qnil;
d666732c5f41 (readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
parents: 2439
diff changeset
1967
5568
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
1968 load_descriptor_list = Qnil;
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
1969 staticpro (&load_descriptor_list);
1af95f18f709 (Fload): Record descriptor numbers on load_descriptor_list.
Richard M. Stallman <rms@gnu.org>
parents: 5496
diff changeset
1970
2901
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
1971 Qcurrent_load_list = intern ("current-load-list");
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
1972 staticpro (&Qcurrent_load_list);
510a7ebce564 (syms_of_lread): Make Vcurrent_load_list ordinary Lisp var.
Richard M. Stallman <rms@gnu.org>
parents: 2781
diff changeset
1973
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 Qstandard_input = intern ("standard-input");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 staticpro (&Qstandard_input);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1976
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1977 Qread_char = intern ("read-char");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 staticpro (&Qread_char);
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1979
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 Qget_file_char = intern ("get-file-char");
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 staticpro (&Qget_file_char);
2044
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
1982
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
1983 Qascii_character = intern ("ascii-character");
258362f03d90 (syms_of_lread): Set up Qascii_character.
Richard M. Stallman <rms@gnu.org>
parents: 2018
diff changeset
1984 staticpro (&Qascii_character);
3625
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
1985
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
1986 Qload = intern ("load");
57174f9b1870 (Fload): Forward all 4 args to magic-name handler.
Richard M. Stallman <rms@gnu.org>
parents: 3041
diff changeset
1987 staticpro (&Qload);
341
84ec93d39015 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 }