annotate src/lread.c @ 2298:872a3a2c3fed

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