1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989,
3 1993 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include <sys/types.h>
35 #include "termhooks.h"
39 #include <sys/inode.h>
46 #ifdef LISP_FLOAT_TYPE
51 #endif /* LISP_FLOAT_TYPE */
53 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
54 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
55 Lisp_Object Qascii_character
;
57 extern Lisp_Object Qevent_symbol_element_mask
;
59 /* non-zero if inside `load' */
62 /* Search path for files to be loaded. */
63 Lisp_Object Vload_path
;
65 /* This is the user-visible association list that maps features to
66 lists of defs in their load files. */
67 Lisp_Object Vload_history
;
69 /* This is useud to build the load history. */
70 Lisp_Object Vcurrent_load_list
;
72 /* File for get_file_char to read from. Use by load */
73 static FILE *instream
;
75 /* When nonzero, read conses in pure space */
78 /* For use within read-from-string (this reader is non-reentrant!!) */
79 static int read_from_string_index
;
80 static int read_from_string_limit
;
82 /* Handle unreading and rereading of characters.
83 Write READCHAR to read a character,
84 UNREAD(c) to unread c to be read again. */
86 #define READCHAR readchar (readcharfun)
87 #define UNREAD(c) unreadchar (readcharfun, c)
90 readchar (readcharfun
)
91 Lisp_Object readcharfun
;
94 register struct buffer
*inbuffer
;
97 if (XTYPE (readcharfun
) == Lisp_Buffer
)
99 inbuffer
= XBUFFER (readcharfun
);
101 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
103 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
104 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
108 if (XTYPE (readcharfun
) == Lisp_Marker
)
110 inbuffer
= XMARKER (readcharfun
)->buffer
;
112 mpos
= marker_position (readcharfun
);
114 if (mpos
> BUF_ZV (inbuffer
) - 1)
116 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
117 if (mpos
!= BUF_GPT (inbuffer
))
118 XMARKER (readcharfun
)->bufpos
++;
120 Fset_marker (readcharfun
, make_number (mpos
+ 1),
121 Fmarker_buffer (readcharfun
));
124 if (EQ (readcharfun
, Qget_file_char
))
125 return getc (instream
);
127 if (XTYPE (readcharfun
) == Lisp_String
)
130 /* This used to be return of a conditional expression,
131 but that truncated -1 to a char on VMS. */
132 if (read_from_string_index
< read_from_string_limit
)
133 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
139 tem
= call0 (readcharfun
);
146 /* Unread the character C in the way appropriate for the stream READCHARFUN.
147 If the stream is a user function, call it with the char as argument. */
150 unreadchar (readcharfun
, c
)
151 Lisp_Object readcharfun
;
154 if (XTYPE (readcharfun
) == Lisp_Buffer
)
156 if (XBUFFER (readcharfun
) == current_buffer
)
159 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
161 else if (XTYPE (readcharfun
) == Lisp_Marker
)
162 XMARKER (readcharfun
)->bufpos
--;
163 else if (XTYPE (readcharfun
) == Lisp_String
)
164 read_from_string_index
--;
165 else if (EQ (readcharfun
, Qget_file_char
))
166 ungetc (c
, instream
);
168 call1 (readcharfun
, make_number (c
));
171 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
173 /* get a character from the tty */
175 extern Lisp_Object
read_char ();
177 /* Read input events until we get one that's acceptable for our purposes.
179 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
180 until we get a character we like, and then stuffed into
183 If ASCII_REQUIRED is non-zero, we check function key events to see
184 if the unmodified version of the symbol has a Qascii_character
185 property, and use that character, if present.
187 If ERROR_NONASCII is non-zero, we signal an error if the input we
188 get isn't an ASCII character with modifiers. If it's zero but
189 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
192 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
193 int no_switch_frame
, ascii_required
, error_nonascii
;
196 return make_number (getchar ());
198 register Lisp_Object val
;
199 register Lisp_Object delayed_switch_frame
= Qnil
;
201 /* Read until we get an acceptable event. */
203 val
= read_char (0, 0, 0, Qnil
, 0);
205 /* switch-frame events are put off until after the next ASCII
206 character. This is better than signalling an error just because
207 the last characters were typed to a separate minibuffer frame,
208 for example. Eventually, some code which can deal with
209 switch-frame events will read it and process it. */
211 && EVENT_HAS_PARAMETERS (val
)
212 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
214 delayed_switch_frame
= val
;
220 /* Convert certain symbols to their ASCII equivalents. */
221 if (XTYPE (val
) == Lisp_Symbol
)
223 Lisp_Object tem
, tem1
, tem2
;
224 tem
= Fget (val
, Qevent_symbol_element_mask
);
227 tem1
= Fget (Fcar (tem
), Qascii_character
);
228 /* Merge this symbol's modifier bits
229 with the ASCII equivalent of its basic code. */
231 XFASTINT (val
) = XINT (tem1
) | XINT (Fcar (Fcdr (tem
)));
235 /* If we don't have a character now, deal with it appropriately. */
236 if (XTYPE (val
) != Lisp_Int
)
240 unread_command_events
= Fcons (val
, Qnil
);
241 error ("Non-character input-event");
248 if (! NILP (delayed_switch_frame
))
249 unread_switch_frame
= delayed_switch_frame
;
255 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
256 "Read a character from the command input (keyboard or macro).\n\
257 It is returned as a number.\n\
258 If the user generates an event which is not a character (i.e. a mouse\n\
259 click or function key event), `read-char' signals an error. As an\n\
260 exception, switch-frame events are put off until non-ASCII events can\n\
262 If you want to read non-character events, or ignore them, call\n\
263 `read-event' or `read-char-exclusive' instead.")
266 return read_filtered_event (1, 1, 1);
269 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
270 "Read an event object from the input stream.")
273 return read_filtered_event (0, 0, 0);
276 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
277 "Read a character from the command input (keyboard or macro).\n\
278 It is returned as a number. Non character events are ignored.")
281 return read_filtered_event (1, 1, 0);
284 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
285 "Don't use this yourself.")
288 register Lisp_Object val
;
289 XSET (val
, Lisp_Int
, getc (instream
));
293 static void readevalloop ();
294 static Lisp_Object
load_unwind ();
296 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
297 "Execute a file of Lisp code named FILE.\n\
298 First try FILE with `.elc' appended, then try with `.el',\n\
299 then try FILE unmodified.\n\
300 This function searches the directories in `load-path'.\n\
301 If optional second arg NOERROR is non-nil,\n\
302 report no error if FILE doesn't exist.\n\
303 Print messages at start and end of loading unless\n\
304 optional third arg NOMESSAGE is non-nil.\n\
305 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
306 suffixes `.elc' or `.el' to the specified name FILE.\n\
307 Return t if file exists.")
308 (str
, noerror
, nomessage
, nosuffix
)
309 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
311 register FILE *stream
;
312 register int fd
= -1;
313 register Lisp_Object lispstream
;
315 int count
= specpdl_ptr
- specpdl
;
319 /* 1 means inhibit the message at the beginning. */
322 CHECK_STRING (str
, 0);
323 str
= Fsubstitute_in_file_name (str
);
325 /* Avoid weird lossage with null string as arg,
326 since it would try to load a directory as a Lisp file */
327 if (XSTRING (str
)->size
> 0)
329 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
337 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
343 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
349 stat (XSTRING (found
)->data
, &s1
);
350 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
351 result
= stat (XSTRING (found
)->data
, &s2
);
352 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
354 message ("Source file `%s' newer than byte-compiled file",
355 XSTRING (found
)->data
);
356 /* Don't immediately overwrite this message. */
360 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
363 stream
= fdopen (fd
, "r");
367 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
370 if (NILP (nomessage
) && !nomessage1
)
371 message ("Loading %s...", XSTRING (str
)->data
);
374 /* We may not be able to store STREAM itself as a Lisp_Object pointer
375 since that is guaranteed to work only for data that has been malloc'd.
376 So malloc a full-size pointer, and record the address of that pointer. */
377 ptr
= (FILE **) xmalloc (sizeof (FILE *));
379 XSET (lispstream
, Lisp_Internal_Stream
, (int) ptr
);
380 record_unwind_protect (load_unwind
, lispstream
);
382 readevalloop (Qget_file_char
, stream
, str
, Feval
, 0);
383 unbind_to (count
, Qnil
);
385 /* Run any load-hooks for this file. */
386 temp
= Fassoc (str
, Vafter_load_alist
);
388 Fprogn (Fcdr (temp
));
391 if (!noninteractive
&& NILP (nomessage
))
392 message ("Loading %s...done", XSTRING (str
)->data
);
397 load_unwind (stream
) /* used as unwind-protect function in load */
400 fclose (*(FILE **) XSTRING (stream
));
401 xfree (XPNTR (stream
));
402 if (--load_in_progress
< 0) load_in_progress
= 0;
408 complete_filename_p (pathname
)
409 Lisp_Object pathname
;
411 register unsigned char *s
= XSTRING (pathname
)->data
;
422 /* Search for a file whose name is STR, looking in directories
423 in the Lisp list PATH, and trying suffixes from SUFFIX.
424 SUFFIX is a string containing possible suffixes separated by colons.
425 On success, returns a file descriptor. On failure, returns -1.
427 EXEC_ONLY nonzero means don't open the files,
428 just look for one that is executable. In this case,
429 returns 1 on success.
431 If STOREPTR is nonzero, it points to a slot where the name of
432 the file actually found should be stored as a Lisp string.
433 Nil is stored there on failure. */
436 openp (path
, str
, suffix
, storeptr
, exec_only
)
437 Lisp_Object path
, str
;
439 Lisp_Object
*storeptr
;
445 register char *fn
= buf
;
448 register Lisp_Object filename
;
454 if (complete_filename_p (str
))
457 for (; !NILP (path
); path
= Fcdr (path
))
461 filename
= Fexpand_file_name (str
, Fcar (path
));
462 if (!complete_filename_p (filename
))
463 /* If there are non-absolute elts in PATH (eg ".") */
464 /* Of course, this could conceivably lose if luser sets
465 default-directory to be something non-absolute... */
467 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
468 if (!complete_filename_p (filename
))
469 /* Give up on this path element! */
473 /* Calculate maximum size of any filename made from
474 this path element/specified file name and any possible suffix. */
475 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
476 if (fn_size
< want_size
)
477 fn
= (char *) alloca (fn_size
= 100 + want_size
);
481 /* Loop over suffixes. */
484 char *esuffix
= (char *) index (nsuffix
, ':');
485 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
487 /* Concatenate path element/specified name with the suffix. */
488 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
489 fn
[XSTRING (filename
)->size
] = 0;
490 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
491 strncat (fn
, nsuffix
, lsuffix
);
493 /* Ignore file if it's a directory. */
494 if (stat (fn
, &st
) >= 0
495 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
497 /* Check that we can access or open it. */
499 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
501 fd
= open (fn
, 0, 0);
505 /* We succeeded; return this descriptor and filename. */
507 *storeptr
= build_string (fn
);
512 /* Advance to next suffix. */
515 nsuffix
+= lsuffix
+ 1;
517 if (absolute
) return -1;
524 /* Merge the list we've accumulated of globals from the current input source
525 into the load_history variable. The details depend on whether
526 the source has an associated file name or not. */
529 build_load_history (stream
, source
)
533 register Lisp_Object tail
, prev
, newelt
;
534 register Lisp_Object tem
, tem2
;
535 register int foundit
, loading
;
537 /* Don't bother recording anything for preloaded files. */
538 if (!NILP (Vpurify_flag
))
541 loading
= stream
|| !NARROWED
;
543 tail
= Vload_history
;
550 /* Find the feature's previous assoc list... */
551 if (!NILP (Fequal (source
, Fcar (tem
))))
555 /* If we're loading, remove it. */
559 Vload_history
= Fcdr (tail
);
561 Fsetcdr (prev
, Fcdr (tail
));
564 /* Otherwise, cons on new symbols that are not already members. */
567 tem2
= Vcurrent_load_list
;
571 newelt
= Fcar (tem2
);
573 if (NILP (Fmemq (newelt
, tem
)))
574 Fsetcar (tail
, Fcons (Fcar (tem
),
575 Fcons (newelt
, Fcdr (tem
))));
588 /* If we're loading, cons the new assoc onto the front of load-history,
589 the most-recently-loaded position. Also do this if we didn't find
590 an existing member for the current source. */
591 if (loading
|| !foundit
)
592 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
597 unreadpure () /* Used as unwind-protect function in readevalloop */
604 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
605 Lisp_Object readcharfun
;
607 Lisp_Object sourcename
;
608 Lisp_Object (*evalfun
) ();
612 register Lisp_Object val
;
613 int count
= specpdl_ptr
- specpdl
;
616 specbind (Qstandard_input
, readcharfun
);
617 specbind (Qcurrent_load_list
, Qnil
);
621 LOADHIST_ATTACH (sourcename
);
629 while ((c
= READCHAR
) != '\n' && c
!= -1);
633 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f') continue;
635 if (!NILP (Vpurify_flag
) && c
== '(')
637 record_unwind_protect (unreadpure
, Qnil
);
638 val
= read_list (-1, readcharfun
);
639 unbind_to (count
+ 1, Qnil
);
644 val
= read0 (readcharfun
);
647 val
= (*evalfun
) (val
);
650 Vvalues
= Fcons (val
, Vvalues
);
651 if (EQ (Vstandard_output
, Qt
))
658 build_load_history (stream
, sourcename
);
661 unbind_to (count
, Qnil
);
666 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
667 "Execute the current buffer as Lisp code.\n\
668 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
669 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
670 PRINTFLAG controls printing of output:\n\
671 nil means discard it; anything else is stream for print.\n\
673 If there is no error, point does not move. If there is an error,\n\
674 point remains at the end of the last character read from the buffer.")
676 Lisp_Object bufname
, printflag
;
678 int count
= specpdl_ptr
- specpdl
;
679 Lisp_Object tem
, buf
;
682 buf
= Fcurrent_buffer ();
684 buf
= Fget_buffer (bufname
);
686 error ("No such buffer.");
688 if (NILP (printflag
))
692 specbind (Qstandard_output
, tem
);
693 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
694 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
695 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
696 unbind_to (count
, Qnil
);
702 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
703 "Execute the current buffer as Lisp code.\n\
704 Programs can pass argument PRINTFLAG which controls printing of output:\n\
705 nil means discard it; anything else is stream for print.\n\
707 If there is no error, point does not move. If there is an error,\n\
708 point remains at the end of the last character read from the buffer.")
710 Lisp_Object printflag
;
712 int count
= specpdl_ptr
- specpdl
;
713 Lisp_Object tem
, cbuf
;
715 cbuf
= Fcurrent_buffer ()
717 if (NILP (printflag
))
721 specbind (Qstandard_output
, tem
);
722 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
724 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
725 return unbind_to (count
, Qnil
);
729 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
730 "Execute the region as Lisp code.\n\
731 When called from programs, expects two arguments,\n\
732 giving starting and ending indices in the current buffer\n\
733 of the text to be executed.\n\
734 Programs can pass third argument PRINTFLAG which controls output:\n\
735 nil means discard it; anything else is stream for printing it.\n\
737 If there is no error, point does not move. If there is an error,\n\
738 point remains at the end of the last character read from the buffer.")
740 Lisp_Object b
, e
, printflag
;
742 int count
= specpdl_ptr
- specpdl
;
743 Lisp_Object tem
, cbuf
;
745 cbuf
= Fcurrent_buffer ();
747 if (NILP (printflag
))
751 specbind (Qstandard_output
, tem
);
753 if (NILP (printflag
))
754 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
755 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
757 /* This both uses b and checks its type. */
759 Fnarrow_to_region (make_number (BEGV
), e
);
760 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
762 return unbind_to (count
, Qnil
);
765 #endif /* standalone */
767 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
768 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
769 If STREAM is nil, use the value of `standard-input' (which see).\n\
770 STREAM or the value of `standard-input' may be:\n\
771 a buffer (read from point and advance it)\n\
772 a marker (read from where it points and advance it)\n\
773 a function (call it with no arguments for each character,\n\
774 call it with a char as argument to push a char back)\n\
775 a string (takes text from string, starting at the beginning)\n\
776 t (read text line using minibuffer and use it).")
778 Lisp_Object readcharfun
;
780 extern Lisp_Object
Fread_minibuffer ();
782 if (NILP (readcharfun
))
783 readcharfun
= Vstandard_input
;
784 if (EQ (readcharfun
, Qt
))
785 readcharfun
= Qread_char
;
788 if (EQ (readcharfun
, Qread_char
))
789 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
792 if (XTYPE (readcharfun
) == Lisp_String
)
793 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
795 return read0 (readcharfun
);
798 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
799 "Read one Lisp expression which is represented as text by STRING.\n\
800 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
801 START and END optionally delimit a substring of STRING from which to read;\n\
802 they default to 0 and (length STRING) respectively.")
804 Lisp_Object string
, start
, end
;
806 int startval
, endval
;
809 CHECK_STRING (string
,0);
812 endval
= XSTRING (string
)->size
;
814 { CHECK_NUMBER (end
,2);
816 if (endval
< 0 || endval
> XSTRING (string
)->size
)
817 args_out_of_range (string
, end
);
823 { CHECK_NUMBER (start
,1);
824 startval
= XINT (start
);
825 if (startval
< 0 || startval
> endval
)
826 args_out_of_range (string
, start
);
829 read_from_string_index
= startval
;
830 read_from_string_limit
= endval
;
832 tem
= read0 (string
);
833 return Fcons (tem
, make_number (read_from_string_index
));
836 /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
840 Lisp_Object readcharfun
;
842 register Lisp_Object val
;
845 val
= read1 (readcharfun
);
846 if (XTYPE (val
) == Lisp_Internal
)
849 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
855 static int read_buffer_size
;
856 static char *read_buffer
;
859 read_escape (readcharfun
)
860 Lisp_Object readcharfun
;
862 register int c
= READCHAR
;
889 error ("Invalid escape character syntax");
892 c
= read_escape (readcharfun
);
893 return c
| meta_modifier
;
898 error ("Invalid escape character syntax");
901 c
= read_escape (readcharfun
);
902 return c
| shift_modifier
;
907 error ("Invalid escape character syntax");
910 c
= read_escape (readcharfun
);
911 return c
| hyper_modifier
;
916 error ("Invalid escape character syntax");
919 c
= read_escape (readcharfun
);
920 return c
| alt_modifier
;
925 error ("Invalid escape character syntax");
928 c
= read_escape (readcharfun
);
929 return c
| super_modifier
;
934 error ("Invalid escape character syntax");
938 c
= read_escape (readcharfun
);
939 if ((c
& 0177) == '?')
941 /* ASCII control chars are made from letters (both cases),
942 as well as the non-letters within 0100...0137. */
943 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
944 return (c
& (037 | ~0177));
945 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
946 return (c
& (037 | ~0177));
948 return c
| ctrl_modifier
;
958 /* An octal escape, as in ANSI C. */
960 register int i
= c
- '0';
961 register int count
= 0;
964 if ((c
= READCHAR
) >= '0' && c
<= '7')
979 /* A hex escape, as in ANSI C. */
985 if (c
>= '0' && c
<= '9')
990 else if ((c
>= 'a' && c
<= 'f')
991 || (c
>= 'A' && c
<= 'F'))
994 if (c
>= 'a' && c
<= 'f')
1015 register Lisp_Object readcharfun
;
1022 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1027 return read_list (0, readcharfun
);
1030 return read_vector (readcharfun
);
1035 register Lisp_Object val
;
1036 XSET (val
, Lisp_Internal
, c
);
1044 /* Accept compiled functions at read-time so that we don't have to
1045 build them using function calls. */
1047 tmp
= read_vector (readcharfun
);
1048 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1049 XVECTOR (tmp
)->contents
);
1051 #ifdef USE_TEXT_PROPERTIES
1055 struct gcpro gcpro1
;
1057 /* Read the string itself. */
1058 tmp
= read1 (readcharfun
);
1059 if (XTYPE (tmp
) != Lisp_String
)
1060 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1062 /* Read the intervals and their properties. */
1065 Lisp_Object beg
, end
, plist
;
1067 beg
= read1 (readcharfun
);
1068 if (XTYPE (beg
) == Lisp_Internal
)
1070 if (XINT (beg
) == ')')
1072 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("invalid string property list", 28), Qnil
));
1074 end
= read1 (readcharfun
);
1075 if (XTYPE (end
) == Lisp_Internal
)
1076 Fsignal (Qinvalid_read_syntax
,
1077 Fcons (make_string ("invalid string property list", 28), Qnil
));
1079 plist
= read1 (readcharfun
);
1080 if (XTYPE (plist
) == Lisp_Internal
)
1081 Fsignal (Qinvalid_read_syntax
,
1082 Fcons (make_string ("invalid string property list", 28), Qnil
));
1083 Fset_text_properties (beg
, end
, plist
, tmp
);
1090 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1093 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1098 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1103 register Lisp_Object val
;
1106 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1109 XSET (val
, Lisp_Int
, read_escape (readcharfun
));
1111 XSET (val
, Lisp_Int
, c
);
1118 register char *p
= read_buffer
;
1119 register char *end
= read_buffer
+ read_buffer_size
;
1123 while ((c
= READCHAR
) >= 0
1128 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1129 p
+= new - read_buffer
;
1130 read_buffer
+= new - read_buffer
;
1131 end
= read_buffer
+ read_buffer_size
;
1134 c
= read_escape (readcharfun
);
1135 /* c is -1 if \ newline has just been seen */
1138 if (p
== read_buffer
)
1141 else if (c
& CHAR_META
)
1142 /* Move the meta bit to the right place for a string. */
1143 *p
++ = (c
& ~CHAR_META
) | 0x80;
1147 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1149 /* If purifying, and string starts with \ newline,
1150 return zero instead. This is for doc strings
1151 that we are really going to find in etc/DOC.nn.nn */
1152 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1153 return make_number (0);
1156 return make_pure_string (read_buffer
, p
- read_buffer
);
1158 return make_string (read_buffer
, p
- read_buffer
);
1163 #ifdef LISP_FLOAT_TYPE
1164 /* If a period is followed by a number, then we should read it
1165 as a floating point number. Otherwise, it denotes a dotted
1167 int next_char
= READCHAR
;
1170 if (! isdigit (next_char
))
1173 register Lisp_Object val
;
1174 XSET (val
, Lisp_Internal
, c
);
1178 /* Otherwise, we fall through! Note that the atom-reading loop
1179 below will now loop at least once, assuring that we will not
1180 try to UNREAD two characters in a row. */
1183 if (c
<= 040) goto retry
;
1185 register char *p
= read_buffer
;
1188 register char *end
= read_buffer
+ read_buffer_size
;
1191 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1192 || c
== '(' || c
== ')'
1193 #ifndef LISP_FLOAT_TYPE
1194 /* If we have floating-point support, then we need
1195 to allow <digits><dot><digits>. */
1197 #endif /* not LISP_FLOAT_TYPE */
1198 || c
== '[' || c
== ']' || c
== '#'
1203 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1204 p
+= new - read_buffer
;
1205 read_buffer
+= new - read_buffer
;
1206 end
= read_buffer
+ read_buffer_size
;
1216 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1217 p
+= new - read_buffer
;
1218 read_buffer
+= new - read_buffer
;
1219 /* end = read_buffer + read_buffer_size; */
1226 /* Is it an integer? */
1229 register Lisp_Object val
;
1231 if (*p1
== '+' || *p1
== '-') p1
++;
1234 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1235 #ifdef LISP_FLOAT_TYPE
1236 /* Integers can have trailing decimal points. */
1237 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1240 /* It is an integer. */
1242 #ifdef LISP_FLOAT_TYPE
1246 XSET (val
, Lisp_Int
, atoi (read_buffer
));
1250 #ifdef LISP_FLOAT_TYPE
1251 if (isfloat_string (read_buffer
))
1252 return make_float (atof (read_buffer
));
1256 return intern (read_buffer
);
1261 #ifdef LISP_FLOAT_TYPE
1276 if (*cp
== '+' || *cp
== '-')
1282 while (isdigit (*cp
))
1293 while (isdigit (*cp
))
1301 if ((*cp
== '+') || (*cp
== '-'))
1307 while (isdigit (*cp
))
1311 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1312 || state
== (DOT_CHAR
|TRAIL_INT
)
1313 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1314 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1315 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1317 #endif /* LISP_FLOAT_TYPE */
1320 read_vector (readcharfun
)
1321 Lisp_Object readcharfun
;
1325 register Lisp_Object
*ptr
;
1326 register Lisp_Object tem
, vector
;
1327 register struct Lisp_Cons
*otem
;
1330 tem
= read_list (1, readcharfun
);
1331 len
= Flength (tem
);
1332 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1335 size
= XVECTOR (vector
)->size
;
1336 ptr
= XVECTOR (vector
)->contents
;
1337 for (i
= 0; i
< size
; i
++)
1339 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1347 /* flag = 1 means check for ] to terminate rather than ) and .
1348 flag = -1 means check for starting with defun
1349 and make structure pure. */
1352 read_list (flag
, readcharfun
)
1354 register Lisp_Object readcharfun
;
1356 /* -1 means check next element for defun,
1357 0 means don't check,
1358 1 means already checked and found defun. */
1359 int defunflag
= flag
< 0 ? -1 : 0;
1360 Lisp_Object val
, tail
;
1361 register Lisp_Object elt
, tem
;
1362 struct gcpro gcpro1
, gcpro2
;
1370 elt
= read1 (readcharfun
);
1372 if (XTYPE (elt
) == Lisp_Internal
)
1376 if (XINT (elt
) == ']')
1378 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1380 if (XINT (elt
) == ')')
1382 if (XINT (elt
) == '.')
1386 XCONS (tail
)->cdr
= read0 (readcharfun
);
1388 val
= read0 (readcharfun
);
1389 elt
= read1 (readcharfun
);
1391 if (XTYPE (elt
) == Lisp_Internal
&& XINT (elt
) == ')')
1393 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1395 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1397 tem
= (read_pure
&& flag
<= 0
1398 ? pure_cons (elt
, Qnil
)
1399 : Fcons (elt
, Qnil
));
1401 XCONS (tail
)->cdr
= tem
;
1406 defunflag
= EQ (elt
, Qdefun
);
1407 else if (defunflag
> 0)
1412 Lisp_Object Vobarray
;
1413 Lisp_Object initial_obarray
;
1416 check_obarray (obarray
)
1417 Lisp_Object obarray
;
1419 while (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1421 /* If Vobarray is now invalid, force it to be valid. */
1422 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1424 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1429 static int hash_string ();
1430 Lisp_Object
oblookup ();
1437 int len
= strlen (str
);
1438 Lisp_Object obarray
= Vobarray
;
1440 if (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1441 obarray
= check_obarray (obarray
);
1442 tem
= oblookup (obarray
, str
, len
);
1443 if (XTYPE (tem
) == Lisp_Symbol
)
1445 return Fintern ((!NILP (Vpurify_flag
)
1446 ? make_pure_string (str
, len
)
1447 : make_string (str
, len
)),
1451 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1452 "Return the canonical symbol whose name is STRING.\n\
1453 If there is none, one is created by this function and returned.\n\
1454 A second optional argument specifies the obarray to use;\n\
1455 it defaults to the value of `obarray'.")
1457 Lisp_Object str
, obarray
;
1459 register Lisp_Object tem
, sym
, *ptr
;
1461 if (NILP (obarray
)) obarray
= Vobarray
;
1462 obarray
= check_obarray (obarray
);
1464 CHECK_STRING (str
, 0);
1466 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1467 if (XTYPE (tem
) != Lisp_Int
)
1470 if (!NILP (Vpurify_flag
))
1471 str
= Fpurecopy (str
);
1472 sym
= Fmake_symbol (str
);
1474 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1475 if (XTYPE (*ptr
) == Lisp_Symbol
)
1476 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1478 XSYMBOL (sym
)->next
= 0;
1483 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1484 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1485 A second optional argument specifies the obarray to use;\n\
1486 it defaults to the value of `obarray'.")
1488 Lisp_Object str
, obarray
;
1490 register Lisp_Object tem
;
1492 if (NILP (obarray
)) obarray
= Vobarray
;
1493 obarray
= check_obarray (obarray
);
1495 CHECK_STRING (str
, 0);
1497 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1498 if (XTYPE (tem
) != Lisp_Int
)
1504 oblookup (obarray
, ptr
, size
)
1505 Lisp_Object obarray
;
1510 register Lisp_Object tail
;
1511 Lisp_Object bucket
, tem
;
1513 if (XTYPE (obarray
) != Lisp_Vector
||
1514 (obsize
= XVECTOR (obarray
)->size
) == 0)
1516 obarray
= check_obarray (obarray
);
1517 obsize
= XVECTOR (obarray
)->size
;
1519 /* Combining next two lines breaks VMS C 2.3. */
1520 hash
= hash_string (ptr
, size
);
1522 bucket
= XVECTOR (obarray
)->contents
[hash
];
1523 if (XFASTINT (bucket
) == 0)
1525 else if (XTYPE (bucket
) != Lisp_Symbol
)
1526 error ("Bad data in guts of obarray"); /* Like CADR error message */
1527 else for (tail
= bucket
; ; XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
))
1529 if (XSYMBOL (tail
)->name
->size
== size
&&
1530 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1532 else if (XSYMBOL (tail
)->next
== 0)
1535 XSET (tem
, Lisp_Int
, hash
);
1540 hash_string (ptr
, len
)
1544 register unsigned char *p
= ptr
;
1545 register unsigned char *end
= p
+ len
;
1546 register unsigned char c
;
1547 register int hash
= 0;
1552 if (c
>= 0140) c
-= 40;
1553 hash
= ((hash
<<3) + (hash
>>28) + c
);
1555 return hash
& 07777777777;
1559 map_obarray (obarray
, fn
, arg
)
1560 Lisp_Object obarray
;
1565 register Lisp_Object tail
;
1566 CHECK_VECTOR (obarray
, 1);
1567 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1569 tail
= XVECTOR (obarray
)->contents
[i
];
1570 if (XFASTINT (tail
) != 0)
1574 if (XSYMBOL (tail
)->next
== 0)
1576 XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
);
1581 mapatoms_1 (sym
, function
)
1582 Lisp_Object sym
, function
;
1584 call1 (function
, sym
);
1587 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1588 "Call FUNCTION on every symbol in OBARRAY.\n\
1589 OBARRAY defaults to the value of `obarray'.")
1591 Lisp_Object function
, obarray
;
1595 if (NILP (obarray
)) obarray
= Vobarray
;
1596 obarray
= check_obarray (obarray
);
1598 map_obarray (obarray
, mapatoms_1
, function
);
1602 #define OBARRAY_SIZE 509
1607 Lisp_Object oblength
;
1611 XFASTINT (oblength
) = OBARRAY_SIZE
;
1613 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1614 Vobarray
= Fmake_vector (oblength
, make_number (0));
1615 initial_obarray
= Vobarray
;
1616 staticpro (&initial_obarray
);
1617 /* Intern nil in the obarray */
1618 /* These locals are to kludge around a pyramid compiler bug. */
1619 hash
= hash_string ("nil", 3);
1620 /* Separate statement here to avoid VAXC bug. */
1621 hash
%= OBARRAY_SIZE
;
1622 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1625 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1626 XSYMBOL (Qnil
)->function
= Qunbound
;
1627 XSYMBOL (Qunbound
)->value
= Qunbound
;
1628 XSYMBOL (Qunbound
)->function
= Qunbound
;
1631 XSYMBOL (Qnil
)->value
= Qnil
;
1632 XSYMBOL (Qnil
)->plist
= Qnil
;
1633 XSYMBOL (Qt
)->value
= Qt
;
1635 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1638 Qvariable_documentation
= intern ("variable-documentation");
1640 read_buffer_size
= 100;
1641 read_buffer
= (char *) malloc (read_buffer_size
);
1646 struct Lisp_Subr
*sname
;
1649 sym
= intern (sname
->symbol_name
);
1650 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1653 #ifdef NOTDEF /* use fset in subr.el now */
1655 defalias (sname
, string
)
1656 struct Lisp_Subr
*sname
;
1660 sym
= intern (string
);
1661 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1665 /* New replacement for DefIntVar; it ignores the doc string argument
1666 on the assumption that make-docfile will handle that. */
1667 /* Define an "integer variable"; a symbol whose value is forwarded
1668 to a C variable of type int. Sample call: */
1669 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1672 defvar_int (namestring
, address
, doc
)
1678 sym
= intern (namestring
);
1679 XSET (XSYMBOL (sym
)->value
, Lisp_Intfwd
, address
);
1682 /* Similar but define a variable whose value is T if address contains 1,
1683 NIL if address contains 0 */
1686 defvar_bool (namestring
, address
, doc
)
1692 sym
= intern (namestring
);
1693 XSET (XSYMBOL (sym
)->value
, Lisp_Boolfwd
, address
);
1696 /* Similar but define a variable whose value is the Lisp Object stored at address. */
1699 defvar_lisp (namestring
, address
, doc
)
1701 Lisp_Object
*address
;
1705 sym
= intern (namestring
);
1706 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1707 staticpro (address
);
1710 /* Similar but don't request gc-marking of the C variable.
1711 Used when that variable will be gc-marked for some other reason,
1712 since marking the same slot twice can cause trouble with strings. */
1715 defvar_lisp_nopro (namestring
, address
, doc
)
1717 Lisp_Object
*address
;
1721 sym
= intern (namestring
);
1722 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1727 /* Similar but define a variable whose value is the Lisp Object stored in
1728 the current buffer. address is the address of the slot in the buffer that is current now. */
1731 defvar_per_buffer (namestring
, address
, type
, doc
)
1733 Lisp_Object
*address
;
1739 extern struct buffer buffer_local_symbols
;
1741 sym
= intern (namestring
);
1742 offset
= (char *)address
- (char *)current_buffer
;
1744 XSET (XSYMBOL (sym
)->value
, Lisp_Buffer_Objfwd
,
1745 (Lisp_Object
*) offset
);
1746 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1747 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
1748 if (*(int *)(offset
+ (char *)&buffer_local_flags
) == 0)
1749 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1750 slot of buffer_local_flags */
1754 #endif /* standalone */
1760 /* Compute the default load-path. */
1762 normal
= PATH_LOADSEARCH
;
1763 Vload_path
= decode_env_path (0, normal
);
1765 if (NILP (Vpurify_flag
))
1766 normal
= PATH_LOADSEARCH
;
1768 normal
= PATH_DUMPLOADSEARCH
;
1770 /* In a dumped Emacs, we normally have to reset the value of
1771 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1772 uses ../lisp, instead of the path of the installed elisp
1773 libraries. However, if it appears that Vload_path was changed
1774 from the default before dumping, don't override that value. */
1777 Lisp_Object dump_path
;
1779 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1780 if (! NILP (Fequal (dump_path
, Vload_path
)))
1781 Vload_path
= decode_env_path (0, normal
);
1784 Vload_path
= decode_env_path (0, normal
);
1787 /* Warn if dirs in the *standard* path don't exist. */
1789 Lisp_Object path_tail
;
1791 for (path_tail
= Vload_path
;
1793 path_tail
= XCONS (path_tail
)->cdr
)
1795 Lisp_Object dirfile
;
1796 dirfile
= Fcar (path_tail
);
1797 if (XTYPE (dirfile
) == Lisp_String
)
1799 dirfile
= Fdirectory_file_name (dirfile
);
1800 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1801 printf ("Warning: lisp library (%s) does not exist.\n",
1802 XSTRING (Fcar (path_tail
))->data
);
1807 /* If the EMACSLOADPATH environment variable is set, use its value.
1808 This doesn't apply if we're dumping. */
1809 if (NILP (Vpurify_flag
)
1810 && egetenv ("EMACSLOADPATH"))
1811 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
1815 load_in_progress
= 0;
1822 defsubr (&Sread_from_string
);
1824 defsubr (&Sintern_soft
);
1826 defsubr (&Seval_buffer
);
1827 defsubr (&Seval_region
);
1828 defsubr (&Sread_char
);
1829 defsubr (&Sread_char_exclusive
);
1830 defsubr (&Sread_event
);
1831 defsubr (&Sget_file_char
);
1832 defsubr (&Smapatoms
);
1834 DEFVAR_LISP ("obarray", &Vobarray
,
1835 "Symbol table for use by `intern' and `read'.\n\
1836 It is a vector whose length ought to be prime for best results.\n\
1837 The vector's contents don't make sense if examined from Lisp programs;\n\
1838 to find all the symbols in an obarray, use `mapatoms'.");
1840 DEFVAR_LISP ("values", &Vvalues
,
1841 "List of values of all expressions which were read, evaluated and printed.\n\
1842 Order is reverse chronological.");
1844 DEFVAR_LISP ("standard-input", &Vstandard_input
,
1845 "Stream for read to get input from.\n\
1846 See documentation of `read' for possible values.");
1847 Vstandard_input
= Qt
;
1849 DEFVAR_LISP ("load-path", &Vload_path
,
1850 "*List of directories to search for files to load.\n\
1851 Each element is a string (directory name) or nil (try default directory).\n\
1852 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1853 otherwise to default specified by file `paths.h' when Emacs was built.");
1855 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
1856 "Non-nil iff inside of `load'.");
1858 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
1859 "An alist of expressions to be evalled when particular files are loaded.\n\
1860 Each element looks like (FILENAME FORMS...).\n\
1861 When `load' is run and the file-name argument is FILENAME,\n\
1862 the FORMS in the corresponding element are executed at the end of loading.\n\n\
1863 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
1864 with no directory specified, since that is how `load' is normally called.\n\
1865 An error in FORMS does not undo the load,\n\
1866 but does prevent execution of the rest of the FORMS.");
1867 Vafter_load_alist
= Qnil
;
1869 DEFVAR_LISP ("load-history", &Vload_history
,
1870 "Alist mapping source file names to symbols and features.\n\
1871 Each alist element is a list that starts with a file name,\n\
1872 except for one element (optional) that starts with nil and describes\n\
1873 definitions evaluated from buffers not visiting files.\n\
1874 The remaining elements of each list are symbols defined as functions\n\
1875 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
1876 Vload_history
= Qnil
;
1878 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
1879 "Used for internal purposes by `load'.");
1880 Vcurrent_load_list
= Qnil
;
1882 Qcurrent_load_list
= intern ("current-load-list");
1883 staticpro (&Qcurrent_load_list
);
1885 Qstandard_input
= intern ("standard-input");
1886 staticpro (&Qstandard_input
);
1888 Qread_char
= intern ("read-char");
1889 staticpro (&Qread_char
);
1891 Qget_file_char
= intern ("get-file-char");
1892 staticpro (&Qget_file_char
);
1894 Qascii_character
= intern ("ascii-character");
1895 staticpro (&Qascii_character
);