X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/151bdc833ef6611acf656aef027513d578b44592..9ac0d9e04198806161ea21e49b0be04e5253fa57:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 279f64a81b..5769fba364 100644 --- a/src/lread.c +++ b/src/lread.c @@ -32,6 +32,8 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "buffer.h" #include "paths.h" #include "commands.h" +#include "keyboard.h" +#include "termhooks.h" #endif #ifdef lint @@ -48,6 +50,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ Lisp_Object Qread_char, Qget_file_char, Qstandard_input; Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; +Lisp_Object Qascii_character; + +extern Lisp_Object Qevent_symbol_element_mask; /* non-zero if inside `load' */ int load_in_progress; @@ -158,20 +163,68 @@ static Lisp_Object read0 (), read1 (), read_list (), read_vector (); /* get a character from the tty */ +extern Lisp_Object read_char (); + DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0, "Read a character from the command input (keyboard or macro).\n\ -It is returned as a number.") +It is returned as a number.\n\ +If the user generates an event which is not a character (i.e. a mouse\n\ +click or function key event), `read-char' signals an error. As an\n\ +exception, switch-frame events are put off until non-ASCII events can\n\ +be read.\n\ +If you want to read non-character events, or ignore them, call\n\ +`read-event' or `read-char-exclusive' instead.") () { register Lisp_Object val; #ifndef standalone - val = read_char (0); - if (XTYPE (val) != Lisp_Int) - { - unread_command_char = val; - error ("Object read was not a character"); - } + { + register Lisp_Object delayed_switch_frame; + + delayed_switch_frame = Qnil; + + for (;;) + { + val = read_char (0, 0, 0, Qnil, 0); + + /* switch-frame events are put off until after the next ASCII + character. This is better than signalling an error just + because the last characters were typed to a separate + minibuffer frame, for example. Eventually, some code which + can deal with switch-frame events will read it and process + it. */ + if (EVENT_HAS_PARAMETERS (val) + && EQ (EVENT_HEAD (val), Qswitch_frame)) + delayed_switch_frame = val; + else + break; + } + + if (! NILP (delayed_switch_frame)) + unread_switch_frame = delayed_switch_frame; + + /* Only ASCII characters are acceptable. + But convert certain symbols to their ASCII equivalents. */ + if (XTYPE (val) == Lisp_Symbol) + { + Lisp_Object tem, tem1, tem2; + tem = Fget (val, Qevent_symbol_element_mask); + if (!NILP (tem)) + { + tem1 = Fget (Fcar (tem), Qascii_character); + /* Merge this symbol's modifier bits + with the ASCII equivalent of its basic code. */ + if (!NILP (tem1)) + XFASTINT (val) = XINT (tem1) | XINT (Fcar (Fcdr (tem))); + } + } + if (XTYPE (val) != Lisp_Int) + { + unread_command_events = Fcons (val, Qnil); + error ("Non-character input-event"); + } + } #else val = getchar (); #endif @@ -179,17 +232,15 @@ It is returned as a number.") return val; } -#ifdef HAVE_X_WINDOWS DEFUN ("read-event", Fread_event, Sread_event, 0, 0, 0, "Read an event object from the input stream.") () { register Lisp_Object val; - val = read_char (0); + val = read_char (0, 0, 0, Qnil, 0); return val; } -#endif DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 0, 0, "Read a character from the command input (keyboard or macro).\n\ @@ -199,9 +250,49 @@ It is returned as a number. Non character events are ignored.") register Lisp_Object val; #ifndef standalone - val = read_char (0); - while (XTYPE (val) != Lisp_Int) - val = read_char (0); + { + Lisp_Object delayed_switch_frame; + + delayed_switch_frame = Qnil; + + for (;;) + { + val = read_char (0, 0, 0, Qnil, 0); + + /* Convert certain symbols (for keys like RET, DEL, TAB) + to ASCII integers. */ + if (XTYPE (val) == Lisp_Symbol) + { + Lisp_Object tem, tem1; + tem = Fget (val, Qevent_symbol_element_mask); + if (!NILP (tem)) + { + tem1 = Fget (Fcar (tem), Qascii_character); + /* Merge this symbol's modifier bits + with the ASCII equivalent of its basic code. */ + if (!NILP (tem1)) + XFASTINT (val) = XINT (tem1) | XINT (Fcar (Fcdr (tem))); + } + } + if (XTYPE (val) == Lisp_Int) + break; + + /* switch-frame events are put off until after the next ASCII + character. This is better than signalling an error just + because the last characters were typed to a separate + minibuffer frame, for example. Eventually, some code which + can deal with switch-frame events will read it and process + it. */ + else if (EVENT_HAS_PARAMETERS (val) + && EQ (EVENT_HEAD (val), Qswitch_frame)) + delayed_switch_frame = val; + + /* Drop everything else. */ + } + + if (! NILP (delayed_switch_frame)) + unread_switch_frame = delayed_switch_frame; + } #else val = getchar (); #endif @@ -244,6 +335,8 @@ Return t if file exists.") Lisp_Object temp; struct gcpro gcpro1; Lisp_Object found; + /* 1 means inhibit the message at the beginning. */ + int nomessage1 = 0; CHECK_STRING (str, 0); str = Fsubstitute_in_file_name (str); @@ -276,8 +369,13 @@ Return t if file exists.") XSTRING (found)->data[XSTRING (found)->size - 1] = 0; result = stat (XSTRING (found)->data, &s2); if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) - message ("Source file `%s' newer than byte-compiled file", - XSTRING (found)->data); + { + message ("Source file `%s' newer than byte-compiled file", + XSTRING (found)->data); + /* Don't immediately overwrite this message. */ + if (!noninteractive) + nomessage1 = 1; + } XSTRING (found)->data[XSTRING (found)->size - 1] = 'c'; } @@ -288,7 +386,7 @@ Return t if file exists.") error ("Failure to create stdio stream for %s", XSTRING (str)->data); } - if (NILP (nomessage)) + if (NILP (nomessage) && !nomessage1) message ("Loading %s...", XSTRING (str)->data); GCPRO1 (str); @@ -319,7 +417,7 @@ load_unwind (stream) /* used as unwind-protect function in load */ Lisp_Object stream; { fclose (*(FILE **) XSTRING (stream)); - free (XPNTR (stream)); + xfree (XPNTR (stream)); if (--load_in_progress < 0) load_in_progress = 0; return Qnil; } @@ -532,7 +630,7 @@ point remains at the end of the last character read from the buffer.") record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, Feval, !NILP (printflag)); - unbind_to (count); + unbind_to (count, Qnil); return Qnil; } @@ -701,6 +799,8 @@ read_escape (readcharfun) return '\007'; case 'b': return '\b'; + case 'd': + return 0177; case 'e': return 033; case 'f': @@ -723,7 +823,43 @@ read_escape (readcharfun) c = READCHAR; if (c == '\\') c = read_escape (readcharfun); - return c | 0200; + return c | meta_modifier; + + case 'S': + c = READCHAR; + if (c != '-') + error ("Invalid escape character syntax"); + c = READCHAR; + if (c == '\\') + c = read_escape (readcharfun); + return c | shift_modifier; + + case 'H': + c = READCHAR; + if (c != '-') + error ("Invalid escape character syntax"); + c = READCHAR; + if (c == '\\') + c = read_escape (readcharfun); + return c | hyper_modifier; + + case 'A': + c = READCHAR; + if (c != '-') + error ("Invalid escape character syntax"); + c = READCHAR; + if (c == '\\') + c = read_escape (readcharfun); + return c | alt_modifier; + + case 's': + c = READCHAR; + if (c != '-') + error ("Invalid escape character syntax"); + c = READCHAR; + if (c == '\\') + c = read_escape (readcharfun); + return c | super_modifier; case 'C': c = READCHAR; @@ -733,10 +869,16 @@ read_escape (readcharfun) c = READCHAR; if (c == '\\') c = read_escape (readcharfun); - if (c == '?') - return 0177; + if ((c & 0177) == '?') + return 0177 | c; + /* ASCII control chars are made from letters (both cases), + as well as the non-letters within 0100...0137. */ + else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) + return (c & (037 | ~0177)); + else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) + return (c & (037 | ~0177)); else - return (c & (0200 | 037)); + return c | ctrl_modifier; case '0': case '1': @@ -834,11 +976,51 @@ read1 (readcharfun) { /* Accept compiled functions at read-time so that we don't have to build them using function calls. */ - Lisp_Object tmp = read_vector (readcharfun); - return Fmake_byte_code (XVECTOR(tmp)->size, XVECTOR (tmp)->contents); + Lisp_Object tmp; + tmp = read_vector (readcharfun); + return Fmake_byte_code (XVECTOR (tmp)->size, + XVECTOR (tmp)->contents); } +#ifdef USE_TEXT_PROPERTIES + if (c == '(') + { + Lisp_Object tmp; + struct gcpro gcpro1; + + /* Read the string itself. */ + tmp = read1 (readcharfun); + if (XTYPE (tmp) != Lisp_String) + Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + GCPRO1 (tmp); + /* Read the intervals and their properties. */ + while (1) + { + Lisp_Object beg, end, plist; + + beg = read1 (readcharfun); + if (XTYPE (beg) == Lisp_Internal) + { + if (XINT (beg) == ')') + break; + Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil)); + } + end = read1 (readcharfun); + if (XTYPE (end) == Lisp_Internal) + Fsignal (Qinvalid_read_syntax, + Fcons (make_string ("invalid string property list", 28), Qnil)); + + plist = read1 (readcharfun); + if (XTYPE (plist) == Lisp_Internal) + Fsignal (Qinvalid_read_syntax, + Fcons (make_string ("invalid string property list", 28), Qnil)); + Fset_text_properties (beg, end, plist, tmp); + } + UNGCPRO; + return tmp; + } +#endif UNREAD (c); - return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); case ';': while ((c = READCHAR) >= 0 && c != '\n'); @@ -884,11 +1066,14 @@ read1 (readcharfun) if (c == '\\') c = read_escape (readcharfun); /* c is -1 if \ newline has just been seen */ - if (c < 0) + if (c == -1) { if (p == read_buffer) cancel = 1; } + else if (c & CHAR_META) + /* Move the meta bit to the right place for a string. */ + *p++ = (c & ~CHAR_META) | 0x80; else *p++ = c; } @@ -980,9 +1165,17 @@ read1 (readcharfun) if (p1 != p) { while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++; +#ifdef LISP_FLOAT_TYPE + /* Integers can have trailing decimal points. */ + if (p1 > read_buffer && p1 < p && *p1 == '.') p1++; +#endif if (p1 == p) - /* It is. */ + /* It is an integer. */ { +#ifdef LISP_FLOAT_TYPE + if (p1[-1] == '.') + p1[-1] = '\0'; +#endif XSET (val, Lisp_Int, atoi (read_buffer)); return val; } @@ -1468,9 +1661,10 @@ defvar_lisp_nopro (namestring, address, doc) the current buffer. address is the address of the slot in the buffer that is current now. */ void -defvar_per_buffer (namestring, address, doc) +defvar_per_buffer (namestring, address, type, doc) char *namestring; Lisp_Object *address; + Lisp_Object type; char *doc; { Lisp_Object sym; @@ -1483,6 +1677,7 @@ defvar_per_buffer (namestring, address, doc) XSET (XSYMBOL (sym)->value, Lisp_Buffer_Objfwd, (Lisp_Object *) offset); *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym; + *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type; if (*(int *)(offset + (char *)&buffer_local_flags) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding slot of buffer_local_flags */ @@ -1565,9 +1760,7 @@ syms_of_lread () defsubr (&Seval_region); defsubr (&Sread_char); defsubr (&Sread_char_exclusive); -#ifdef HAVE_X_WINDOWS defsubr (&Sread_event); -#endif /* HAVE_X_WINDOWS */ defsubr (&Sget_file_char); defsubr (&Smapatoms); @@ -1590,7 +1783,7 @@ See documentation of `read' for possible values."); "*List of directories to search for files to load.\n\ Each element is a string (directory name) or nil (try default directory).\n\ Initialized based on EMACSLOADPATH environment variable, if any,\n\ -otherwise to default specified in by file `paths.h' when Emacs was built."); +otherwise to default specified by file `paths.h' when Emacs was built."); DEFVAR_BOOL ("load-in-progress", &load_in_progress, "Non-nil iff inside of `load'."); @@ -1614,4 +1807,7 @@ but does prevent execution of the rest of the FORMS."); Qget_file_char = intern ("get-file-char"); staticpro (&Qget_file_char); + + Qascii_character = intern ("ascii-character"); + staticpro (&Qascii_character); }