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