annotate src/lread.c @ 464:4ddaee1a9029

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