From ffd56f97cf56501f7a6981c184192e9043e4eafd Mon Sep 17 00:00:00 2001 From: Jim Blandy Date: Mon, 18 May 1992 08:14:41 +0000 Subject: [PATCH] *** empty log message *** --- lisp/emacs-lisp/autoload.el | 5 ++- lisp/loadup.el | 5 +++ lisp/startup.el | 16 ++++--- lisp/subr.el | 4 ++ src/.gdbinit | 1 + src/alloc.c | 12 ++++-- src/buffer.c | 45 +++++++++++--------- src/callint.c | 7 +--- src/callproc.c | 36 +++++++++------- src/data.c | 78 ++++++++++++++++++++++++++++++---- src/editfns.c | 45 ++++++++++++-------- src/eval.c | 62 +++++++-------------------- src/fileio.c | 2 +- src/keyboard.c | 39 +++++++++-------- src/lisp.h | 4 +- src/minibuf.c | 6 +-- src/process.c | 84 +++++++++++++------------------------ src/search.c | 80 ++++++++++++++++++++--------------- src/sysdep.c | 8 ++-- src/systty.h | 13 ++++++ src/termhooks.h | 6 +-- src/xselect.c.old | 17 ++++---- 22 files changed, 328 insertions(+), 247 deletions(-) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 0a7c9dc74c..5e78798c05 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1,5 +1,5 @@ ;;; Maintain autoloads in loaddefs.el. -;;; Copyright (C) 1991 Free Software Foundation, Inc. +;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc. ;;; Written by Roland McGrath. ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -267,7 +267,7 @@ file \"%s\") doesn't exist. Remove its autoload section? " Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads] on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. -For example, invoke \"emacs -batch -f batch-byte-compile *.el\"" +For example, invoke \"emacs -batch -f batch-update-autoloads *.el\"" (if (not noninteractive) (error "batch-update-file-autoloads is to be used only with -batch")) (let ((lost nil) @@ -288,3 +288,4 @@ For example, invoke \"emacs -batch -f batch-byte-compile *.el\"" (kill-emacs (if lost 1 0)))) (provide 'autoload) + diff --git a/lisp/loadup.el b/lisp/loadup.el index a94f4d6cc2..3b8e7bbd67 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -18,6 +18,8 @@ ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; We don't want to have any undo records in the dumped Emacs. +(buffer-disable-undo "*scratch*") (load "subr") (load "map-ynp") @@ -107,6 +109,9 @@ (load "site-init" t) (garbage-collect) +;;; At this point, we're ready to resume undo recording for scratch. +(buffer-enable-undo "*scratch*") + (if (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) (if (eq system-type 'vax-vms) diff --git a/lisp/startup.el b/lisp/startup.el index 3bd20aa9de..0594a0b2da 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -115,11 +115,17 @@ directory name of the directory where the `.emacs' file was looked for.") (message "Back to top level.") (setq command-line-processed t) ;; In presence of symlinks, switch to cleaner form of default directory. - (if (and (not (eq system-type 'vax-vms)) - (getenv "PWD") - (equal (nthcdr 10 (file-attributes default-directory)) - (nthcdr 10 (file-attributes (getenv "PWD"))))) - (setq default-directory (file-name-as-directory (getenv "PWD")))) + (if (not (eq system-type 'vax-vms)) + (mapcar (function + (lambda (var) + (let ((value (getev var))) + (if (and value + (< (length value) (length default-directory)) + (equal (file-attributes default-directory) + (file-attributes value))) + (setq default-directory + (file-name-as-directory value)))))) + '("PWD" "HOME"))) (let ((tail directory-abbrev-alist)) (while tail (if (string-match (car (car tail)) default-directory) diff --git a/lisp/subr.el b/lisp/subr.el index 245ac651e2..c29261c7d5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -340,3 +340,7 @@ and then modifies one entry in it." (setq i (1+ i))) (setq keyboard-translate-table table))) (aset keyboard-translate-table from to)) + + +(defmacro lambda (&rest cdr) + (` (function (lambda (,@ cdr))))) diff --git a/src/.gdbinit b/src/.gdbinit index 55000f571e..91a921119e 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -91,6 +91,7 @@ end define xcons print (struct Lisp_Cons *) ($ & 0x00ffffff) print *$ +print $$ end document xcons Print the contents of $, assuming it is an Elisp cons. diff --git a/src/alloc.c b/src/alloc.c index 9b7da1d0f5..9c63f8fe13 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1077,15 +1077,21 @@ Garbage collection happens automatically if you cons more than\n\ tem = Fnthcdr (make_number (30), Vcommand_history); if (CONSP (tem)) XCONS (tem)->cdr = Qnil; + /* Likewise for undo information. */ { register struct buffer *nextb = all_buffers; while (nextb) { - nextb->undo_list - = truncate_undo_list (nextb->undo_list, undo_threshold, - undo_high_threshold); + /* If a buffer's undo list is Qt, that means that undo is + turned off in that buffer. Calling truncate_undo_list on + Qt tends to return NULL, which effectively turns undo back on. + So don't call truncate_undo_list if undo_list is Qt. */ + if (! EQ (nextb->undo_list, Qt)) + nextb->undo_list + = truncate_undo_list (nextb->undo_list, undo_threshold, + undo_high_threshold); nextb = nextb->next; } } diff --git a/src/buffer.c b/src/buffer.c index fbf6bb8b61..de9e4246f8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -558,11 +558,22 @@ If BUFFER is omitted or nil, some interesting buffer is returned.") DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1, 0, "Make BUFFER stop keeping undo information.") - (buf) - register Lisp_Object buf; + (buffer) + register Lisp_Object buffer; { - CHECK_BUFFER (buf, 0); - XBUFFER (buf)->undo_list = Qt; + Lisp_Object real_buffer; + + if (NILP (buffer)) + XSET (real_buffer, Lisp_Buffer, current_buffer); + else + { + real_buffer = Fget_buffer (buffer); + if (NILP (real_buffer)) + nsberror (buffer); + } + + XBUFFER (real_buffer)->undo_list = Qt; + return Qnil; } @@ -570,23 +581,22 @@ DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, 0, 1, "", "Start keeping undo information for buffer BUFFER.\n\ No argument or nil as argument means do this for the current buffer.") - (buf) - register Lisp_Object buf; + (buffer) + register Lisp_Object buffer; { - register struct buffer *b; - register Lisp_Object buf1; + Lisp_Object real_buffer; - if (NILP (buf)) - b = current_buffer; + if (NILP (buffer)) + XSET (real_buffer, Lisp_Buffer, current_buffer); else { - buf1 = Fget_buffer (buf); - if (NILP (buf1)) nsberror (buf); - b = XBUFFER (buf1); + real_buffer = Fget_buffer (buffer); + if (NILP (real_buffer)) + nsberror (buffer); } - if (EQ (b->undo_list, Qt)) - b->undo_list = Qnil; + if (EQ (XBUFFER (real_buffer)->undo_list, Qt)) + XBUFFER (real_buffer)->undo_list = Qnil; return Qnil; } @@ -1285,10 +1295,7 @@ init_buffer_once () /* super-magic invisible buffer */ Vbuffer_alist = Qnil; - tem = Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); - /* Want no undo records for *scratch* - until after Emacs is dumped */ - Fbuffer_disable_undo (tem); + Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); } init_buffer () diff --git a/src/callint.c b/src/callint.c index 88c1672111..aeb6ef3872 100644 --- a/src/callint.c +++ b/src/callint.c @@ -179,12 +179,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") retry: - for (fun = function; - XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound); - fun = XSYMBOL (fun)->function) - { - QUIT; - } + fun = indirect_function (function); specs = Qnil; string = 0; diff --git a/src/callproc.c b/src/callproc.c index 9544ecf0a2..85fbcf7c78 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -125,25 +125,29 @@ If you quit, the process is killed with SIGKILL.") CHECK_STRING (infile, 1); } else +#ifdef VMS + infile = build_string ("NLA0:"); +#else infile = build_string ("/dev/null"); +#endif /* not VMS */ - { - register Lisp_Object tem; - if (nargs < 3) - buffer = Qnil; - else - { - buffer = tem = args[2]; - if (!(EQ (tem, Qnil) || EQ (tem, Qt) - || XFASTINT (tem) == 0)) - { - buffer = Fget_buffer (tem); - CHECK_BUFFER (buffer, 2); - } - } - } + if (nargs >= 3) + { + register Lisp_Object tem; + + buffer = tem = args[2]; + if (!(EQ (tem, Qnil) + || EQ (tem, Qt) + || XFASTINT (tem) == 0)) + { + buffer = Fget_buffer (tem); + CHECK_BUFFER (buffer, 2); + } + } + else + buffer = Qnil; - display = nargs >= 3 ? args[3] : Qnil; + display = nargs >= 4 ? args[3] : Qnil; { register int i; diff --git a/src/data.c b/src/data.c index 4e95494d59..df85ef254e 100644 --- a/src/data.c +++ b/src/data.c @@ -37,7 +37,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; -Lisp_Object Qvoid_variable, Qvoid_function; +Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection; Lisp_Object Qsetting_constant, Qinvalid_read_syntax; Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; Lisp_Object Qend_of_file, Qarith_error; @@ -480,13 +480,13 @@ DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's functi DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, "Return SYMBOL's function definition. Error if that is void.") - (sym) - register Lisp_Object sym; + (symbol) + register Lisp_Object symbol; { - CHECK_SYMBOL (sym, 0); - if (EQ (XSYMBOL (sym)->function, Qunbound)) - return Fsignal (Qvoid_function, Fcons (sym, Qnil)); - return XSYMBOL (sym)->function; + CHECK_SYMBOL (symbol, 0); + if (EQ (XSYMBOL (symbol)->function, Qunbound)) + return Fsignal (Qvoid_function, Fcons (symbol, Qnil)); + return XSYMBOL (symbol)->function; } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.") @@ -530,6 +530,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, XSYMBOL (sym)->plist = newplist; return newplist; } + /* Getting and setting values of symbols */ @@ -1094,6 +1095,61 @@ From now on the default value will apply in this buffer.") return sym; } +/* Find the function at the end of a chain of symbol function indirections. */ + +/* If OBJECT is a symbol, find the end of its function chain and + return the value found there. If OBJECT is not a symbol, just + return it. If there is a cycle in the function chain, signal a + cyclic-function-indirection error. + + This is like Findirect_function, except that it doesn't signal an + error if the chain ends up unbound. */ +Lisp_Object +indirect_function (object, error) + register Lisp_Object object; +{ + Lisp_Object tortise, hare; + + hare = tortise = object; + + for (;;) + { + if (XTYPE (hare) != Lisp_Symbol || EQ (hare, Qunbound)) + break; + hare = XSYMBOL (hare)->function; + if (XTYPE (hare) != Lisp_Symbol || EQ (hare, Qunbound)) + break; + hare = XSYMBOL (hare)->function; + + tortise = XSYMBOL (tortise)->function; + + if (EQ (hare, tortise)) + Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil)); + } + + return hare; +} + +DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0, + "Return the function at the end of OBJECT's function chain.\n\ +If OBJECT is a symbol, follow all function indirections and return the final\n\ +function binding.\n\ +If OBJECT is not a symbol, just return it.\n\ +Signal a void-function error if the final symbol is unbound.\n\ +Signal a cyclic-function-indirection error if there is a loop in the\n\ +function chain of symbols.") + (object) + register Lisp_Object object; +{ + Lisp_Object result; + + result = indirect_function (object); + + if (EQ (result, Qunbound)) + return Fsignal (Qvoid_function, Fcons (object, Qnil)); + return result; +} + /* Extract and set vector and string elements */ DEFUN ("aref", Faref, Saref, 2, 2, 0, @@ -1698,6 +1754,7 @@ syms_of_data () Qwrong_type_argument = intern ("wrong-type-argument"); Qargs_out_of_range = intern ("args-out-of-range"); Qvoid_function = intern ("void-function"); + Qcyclic_function_indirection = intern ("cyclic-function-indirection"); Qvoid_variable = intern ("void-variable"); Qsetting_constant = intern ("setting-constant"); Qinvalid_read_syntax = intern ("invalid-read-syntax"); @@ -1762,6 +1819,11 @@ syms_of_data () Fput (Qvoid_function, Qerror_message, build_string ("Symbol's function definition is void")); + Fput (Qcyclic_function_indirection, Qerror_conditions, + Fcons (Qcyclic_function_indirection, Fcons (Qerror, Qnil))); + Fput (Qcyclic_function_indirection, Qerror_message, + build_string ("Symbol's chain of function indirections contains a loop")); + Fput (Qvoid_variable, Qerror_conditions, Fcons (Qvoid_variable, Fcons (Qerror, Qnil))); Fput (Qvoid_variable, Qerror_message, @@ -1832,6 +1894,7 @@ syms_of_data () staticpro (&Qwrong_type_argument); staticpro (&Qargs_out_of_range); staticpro (&Qvoid_function); + staticpro (&Qcyclic_function_indirection); staticpro (&Qvoid_variable); staticpro (&Qsetting_constant); staticpro (&Qinvalid_read_syntax); @@ -1898,6 +1961,7 @@ syms_of_data () defsubr (&Ssetcar); defsubr (&Ssetcdr); defsubr (&Ssymbol_function); + defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); defsubr (&Smakunbound); diff --git a/src/editfns.c b/src/editfns.c index 0ef059aa05..6164ef3279 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -680,7 +680,32 @@ Both arguments are required.") } -/* Return a string with the contents of the current region */ +/* Making strings from buffer contents. */ + +/* Return a Lisp_String containing the text of the current buffer from + START to END. + + We don't want to use plain old make_string here, because it calls + make_uninit_string, which can cause the buffer arena to be + compacted. make_string has no way of knowing that the data has + been moved, and thus copies the wrong data into the string. This + doesn't effect most of the other users of make_string, so it should + be left as is. But we should use this function when conjuring + buffer substrings. */ +Lisp_Object +make_buffer_string (start, end) + int start, end; +{ + Lisp_Object result; + + if (start < GPT && GPT < end) + move_gap (start); + + result = make_uninit_string (end - start); + bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start); + + return result; +} DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0, "Return the contents of part of the current buffer as a string.\n\ @@ -690,33 +715,19 @@ they can be in either order.") Lisp_Object b, e; { register int beg, end; - Lisp_Object result; validate_region (&b, &e); beg = XINT (b); end = XINT (e); - if (beg < GPT && end > GPT) - move_gap (beg); - - /* Plain old make_string calls make_uninit_string, which can cause - the buffer arena to be compacted. make_string has no way of - knowing that the data has been moved, and thus copies the wrong - data into the string. This doesn't effect most of the other - users of make_string, so it should be left as is. */ - result = make_uninit_string (end - beg); - bcopy (&FETCH_CHAR (beg), XSTRING (result)->data, end - beg); - - return result; + return make_buffer_string (beg, end); } DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, "Return the contents of the current buffer as a string.") () { - if (BEGV < GPT && ZV > GPT) - move_gap (BEGV); - return make_string (BEGV_ADDR, ZV - BEGV); + return make_buffer_string (BEGV, ZV); } DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, diff --git a/src/eval.c b/src/eval.c index c4fcc808c5..ab0ae207f2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -465,12 +465,7 @@ and input is currently coming from the keyboard (not in keyboard macro).") that DOES eval its args. If it is a built-in function (such as load or eval-region) return nil. */ - fun = *btp->function; - while (XTYPE (fun) == Lisp_Symbol) - { - QUIT; - fun = Fsymbol_function (fun); - } + fun = Findirect_function (*btp->function); if (XTYPE (fun) == Lisp_Subr) return Qnil; /* btp points to the frame of a Lisp function that called interactive-p. @@ -1206,14 +1201,9 @@ Also, a symbol satisfies `commandp' if its function definition does so.") fun = function; - /* Dereference symbols, but avoid infinte loops. Eech. */ - while (XTYPE (fun) == Lisp_Symbol) - { - if (++i > 10) return Qnil; - tem = Ffboundp (fun); - if (NILP (tem)) return Qnil; - fun = Fsymbol_function (fun); - } + fun = indirect_function (fun); + if (EQ (fun, Qunbound)) + return Qnil; /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ @@ -1333,14 +1323,8 @@ do_autoload (fundef, funname) Vautoload_queue = Qt; unbind_to (count, Qnil); - while (XTYPE (fun) == Lisp_Symbol) - { - QUIT; - val = XSYMBOL (fun)->function; - if (EQ (val, Qunbound)) - Fsymbol_function (fun); /* Get the right kind of error! */ - fun = val; - } + fun = Findirect_function (fun); + if (XTYPE (fun) == Lisp_Cons && EQ (XCONS (fun)->car, Qautoload)) error ("Autoloading failed to define function %s", @@ -1404,15 +1388,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, /* At this point, only original_fun and original_args have values that will be used below */ retry: - fun = original_fun; - while (XTYPE (fun) == Lisp_Symbol) - { - QUIT; - val = XSYMBOL (fun)->function; - if (EQ (val, Qunbound)) - Fsymbol_function (fun); /* Get the right kind of error! */ - fun = val; - } + fun = Findirect_function (original_fun); if (XTYPE (fun) == Lisp_Subr) { @@ -1582,16 +1558,12 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.") numargs += nargs - 2; - while (XTYPE (fun) == Lisp_Symbol) + fun = indirect_function (fun); + if (EQ (fun, Qunbound)) { - QUIT; - fun = XSYMBOL (fun)->function; - if (EQ (fun, Qunbound)) - { - /* Let funcall get the error */ - fun = args[0]; - goto funcall; - } + /* Let funcall get the error */ + fun = args[0]; + goto funcall; } if (XTYPE (fun) == Lisp_Subr) @@ -1779,14 +1751,8 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).") retry: fun = args[0]; - while (XTYPE (fun) == Lisp_Symbol) - { - QUIT; - val = XSYMBOL (fun)->function; - if (EQ (val, Qunbound)) - Fsymbol_function (fun); /* Get the right kind of error! */ - fun = val; - } + + fun = Findirect_function (fun); if (XTYPE (fun) == Lisp_Subr) { diff --git a/src/fileio.c b/src/fileio.c index f977ee0c62..a317db7c69 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -17,6 +17,7 @@ You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +#include "config.h" #include #include @@ -52,7 +53,6 @@ extern int sys_nerr; #include #endif -#include "config.h" #include "lisp.h" #include "buffer.h" #include "window.h" diff --git a/src/keyboard.c b/src/keyboard.c index e6139cfaf1..5b0d5facfc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -43,6 +43,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "syssignal.h" #include "systerm.h" +#include "systime.h" extern int errno; @@ -311,8 +312,9 @@ Lisp_Object Qmode_line; Lisp_Object Qvertical_split; -/* Address (if not 0) of word to zero out if a SIGIO interrupt happens. */ -long *input_available_clear_word; +/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt + happens. */ +EMACS_TIME *input_available_clear_time; /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode. Default is 1 if INTERRUPT_INPUT is defined. */ @@ -1160,8 +1162,7 @@ read_char (commandflag) XSET (Vlast_event_screen, Lisp_Screen, selected_screen); #endif - waiting_for_input = 0; - input_available_clear_word = 0; + clear_waiting_for_input (); goto non_reread; } @@ -1491,7 +1492,7 @@ kbd_buffer_store_event (event) will set Vlast_event_screen again, so this is safe to do. */ extern SIGTYPE interrupt_signal (); XSET (Vlast_event_screen, Lisp_Screen, event->screen); - last_event_timestamp = XINT (event->timestamp); + last_event_timestamp = event->timestamp; interrupt_signal (); return; } @@ -2237,8 +2238,8 @@ input_available_signal (signo) sigisheld (SIGIO); #endif - if (input_available_clear_word) - *input_available_clear_word = 0; + if (input_available_clear_time) + EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); while (1) { @@ -2793,13 +2794,7 @@ Otherwise, that is done only if an arg is read using the minibuffer.") while (1) { - final = cmd; - while (XTYPE (final) == Lisp_Symbol) - { - if (EQ (Qunbound, XSYMBOL (final)->function)) - Fsymbol_function (final); /* Get an error! */ - final = XSYMBOL (final)->function; - } + final = Findirect_function (cmd); if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload))) do_autoload (final, cmd); @@ -3012,6 +3007,14 @@ detect_input_pending () return input_pending; } +/* This is called in some cases before a possible quit. + It cases the next call to detect_input_pending to recompute input_pending. + So calling this function unnecessarily can't do any harm. */ +clear_input_pending () +{ + input_pending = 0; +} + DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, "T if command input is currently available with no waiting.\n\ Actually, the value is nil only if we can be sure that no input is available.") @@ -3194,10 +3197,10 @@ stuff_buffered_input (stuffstring) #endif /* BSD and not BSD4_1 */ } -set_waiting_for_input (word_to_clear) - long *word_to_clear; +set_waiting_for_input (time_to_clear) + EMACS_TIME *time_to_clear; { - input_available_clear_word = word_to_clear; + input_available_clear_time = time_to_clear; /* Tell interrupt_signal to throw back to read_char, */ waiting_for_input = 1; @@ -3219,7 +3222,7 @@ clear_waiting_for_input () { /* Tell interrupt_signal not to throw back to read_char, */ waiting_for_input = 0; - input_available_clear_word = 0; + input_available_clear_time = 0; } /* This routine is called at interrupt level in response to C-G. diff --git a/src/lisp.h b/src/lisp.h index b263370dac..b0b0cb4fc5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -852,6 +852,7 @@ extern Lisp_Object Fcar (), Fcar_safe(), Fcdr (), Fcdr_safe(); extern Lisp_Object Fsetcar (), Fsetcdr (); extern Lisp_Object Fboundp (), Ffboundp (), Fmakunbound (), Ffmakunbound (); extern Lisp_Object Fsymbol_function (), Fsymbol_plist (), Fsymbol_name (); +extern Lisp_Object indirect_function (), Findirect_function (); extern Lisp_Object Ffset (), Fsetplist (); extern Lisp_Object Fsymbol_value (), find_symbol_value (), Fset (); extern Lisp_Object Fdefault_value (), Fset_default (); @@ -951,7 +952,8 @@ extern Lisp_Object Ffollowing_char (), Fprevious_char (), Fchar_after (); extern Lisp_Object Finsert (); extern Lisp_Object Feolp (), Feobp (), Fbolp (), Fbobp (); extern Lisp_Object Fformat (), format1 (); -extern Lisp_Object Fbuffer_substring (), Fbuffer_string (); +extern Lisp_Object make_buffer_string (), Fbuffer_substring (); +extern Lisp_Object Fbuffer_string (); extern Lisp_Object Fstring_equal (), Fstring_lessp (), Fbuffer_substring_lessp (); extern Lisp_Object save_excursion_save (), save_restriction_save (); extern Lisp_Object save_excursion_restore (), save_restriction_restore (); diff --git a/src/minibuf.c b/src/minibuf.c index 93c9f26727..df45dac748 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1,11 +1,11 @@ /* Minibuffer input and completion. - Copyright (C) 1985, 1986 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -195,7 +195,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag) } /* Make minibuffer contents into a string */ - val = make_string (BEG_ADDR, Z - BEG); + val = make_buffer_string (1, Z); bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT); unbind_to (count, Qnil); /* The appropriate screen will get selected in set-window-configuration. */ diff --git a/src/process.c b/src/process.c index 9ba48ef7d5..68bdfa334e 100644 --- a/src/process.c +++ b/src/process.c @@ -65,41 +65,12 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #endif -#ifdef HPUX -#undef TIOCGPGRP -#endif - #ifdef IRIS #include /* for "minor" */ #endif /* not IRIS */ #include "systime.h" - -#if defined (HPUX) && defined (HAVE_PTYS) -#include -#endif - -#ifdef AIX -#include -#include -#endif - -#ifdef SYSV_PTYS -#include -#ifdef titan -#include -#include -#endif -#include -#endif - -#ifdef XENIX -#undef TIOCGETC /* Avoid confusing some conditionals that test this. */ -#endif - -#ifdef BROKEN_TIOCGETC -#undef TIOCGETC -#endif +#include "systerm.h" #include "lisp.h" #include "window.h" @@ -1690,10 +1661,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) EMACS_ADD_TIME (end_time, end_time, timeout); } - /* Turn off periodic alarms (in case they are in use) - because the select emulator uses alarms. */ - stop_polling (); - while (1) { /* If calling from keyboard input, do not quit @@ -1752,6 +1719,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (!read_kbd) FD_CLR (0, &Available); + /* If screen size has changed or the window is newly mapped, + redisplay now, before we start to wait. There is a race + condition here; if a SIGIO arrives between now and the select + and indicates that a screen is trashed, we lose. */ + if (screen_garbaged) + redisplay_preserve_echo_area (); + if (read_kbd && detect_input_pending ()) nfds = 0; else @@ -1765,7 +1739,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If we woke up due to SIGWINCH, actually change size now. */ do_pending_window_change (); - if (time_limit && nfds == 0) /* timeout elapsed */ + if (time_limit && nfds == 0) /* timeout elapsed */ break; if (nfds < 0) { @@ -1787,7 +1761,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF in m-ibmrt-aix.h), and here we just ignore the select error. Cleanup occurs c/o status_notify after SIGCLD. */ - FD_ZERO (&Available); /* Cannot depend on values returned */ + FD_ZERO (&Available); /* Cannot depend on values returned */ #else abort (); #endif @@ -1815,8 +1789,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) but select says there is input. */ /* - if (read_kbd && interrupt_input && (Available & fileno (stdin))) - */ + if (read_kbd && interrupt_input && (Available & fileno (stdin))) + */ if (read_kbd && interrupt_input && (FD_ISSET (fileno (stdin), &Available))) kill (0, SIGIO); #endif @@ -1839,11 +1813,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (read_kbd) do_pending_window_change (); - /* If screen size has changed, redisplay now - for either sit-for or keyboard input. */ - if (read_kbd && screen_garbaged) - redisplay_preserve_echo_area (); - /* Check for data from a process or a command channel */ for (channel = FIRST_PROC_DESC; channel < MAXDESC; channel++) { @@ -1880,7 +1849,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } continue; } -#endif /* vipc */ +#endif /* vipc */ /* Read data from the process, starting with our buffered-ahead character if we have one. */ @@ -1914,9 +1883,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) subprocess termination and SIGCHLD. */ else if (nread == 0 && !NETCONN_P (proc)) ; -#endif /* O_NDELAY */ -#endif /* O_NONBLOCK */ -#endif /* EWOULDBLOCK */ +#endif /* O_NDELAY */ +#endif /* O_NONBLOCK */ +#endif /* EWOULDBLOCK */ #ifdef HAVE_PTYS /* On some OSs with ptys, when the process on one end of a pty exits, the other end gets an error reading with @@ -1927,9 +1896,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) get a SIGCHLD). */ else if (nread == -1 && errno == EIO) ; -#endif /* HAVE_PTYS */ -/* If we can detect process termination, don't consider the process - gone just because its pipe is closed. */ +#endif /* HAVE_PTYS */ + /* If we can detect process termination, don't consider the process + gone just because its pipe is closed. */ #ifdef SIGCHLD else if (nread == 0 && !NETCONN_P (proc)) ; @@ -1946,11 +1915,18 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) = Fcons (Qexit, Fcons (make_number (256), Qnil)); } } - } /* end for each file descriptor */ - } /* end while exit conditions not met */ + } /* end for each file descriptor */ + } /* end while exit conditions not met */ - /* Resume periodic signals to poll for input, if necessary. */ - start_polling (); + /* If calling from keyboard input, do not quit + since we want to return C-g as an input character. + Otherwise, do pending quit if requested. */ + if (read_kbd >= 0) + { + /* Prevent input_pending from remaining set if we quit. */ + clear_input_pending (); + QUIT; + } return got_some_input; } diff --git a/src/search.c b/src/search.c index 9ac63aea87..5f1f17f2d5 100644 --- a/src/search.c +++ b/src/search.c @@ -210,80 +210,94 @@ matched by parenthesis constructs in the pattern.") return make_number (val); } -scan_buffer (target, pos, cnt, shortage) - int *shortage, pos; - register int cnt, target; +/* Search for COUNT instances of the character TARGET, starting at START. + If COUNT is negative, search backwards. + + If we find COUNT instances, set *SHORTAGE to zero, and return the + position of the COUNTth character. + + If we don't find COUNT instances before reaching the end of the + buffer (or the beginning, if scanning backwards), set *SHORTAGE to + the number of TARGETs left unfound, and return the end of the + buffer we bumped up against. */ + +scan_buffer (target, start, count, shortage) + int *shortage, start; + register int count, target; { - int lim = ((cnt > 0) ? ZV - 1 : BEGV); - int direction = ((cnt > 0) ? 1 : -1); - register int lim0; + int limit = ((count > 0) ? ZV - 1 : BEGV); + int direction = ((count > 0) ? 1 : -1); + + register unsigned char *cursor; unsigned char *base; - register unsigned char *cursor, *limit; + + register int ceiling; + register unsigned char *ceiling_addr; if (shortage != 0) *shortage = 0; immediate_quit = 1; - if (cnt > 0) - while (pos != lim + 1) + if (count > 0) + while (start != limit + 1) { - lim0 = BUFFER_CEILING_OF (pos); - lim0 = min (lim, lim0); - limit = &FETCH_CHAR (lim0) + 1; - base = (cursor = &FETCH_CHAR (pos)); + ceiling = BUFFER_CEILING_OF (start); + ceiling = min (limit, ceiling); + ceiling_addr = &FETCH_CHAR (ceiling) + 1; + base = (cursor = &FETCH_CHAR (start)); while (1) { - while (*cursor != target && ++cursor != limit) + while (*cursor != target && ++cursor != ceiling_addr) ; - if (cursor != limit) + if (cursor != ceiling_addr) { - if (--cnt == 0) + if (--count == 0) { immediate_quit = 0; - return (pos + cursor - base + 1); + return (start + cursor - base + 1); } else - if (++cursor == limit) + if (++cursor == ceiling_addr) break; } else break; } - pos += cursor - base; + start += cursor - base; } else { - pos--; /* first character we scan */ - while (pos > lim - 1) - { /* we WILL scan under pos */ - lim0 = BUFFER_FLOOR_OF (pos); - lim0 = max (lim, lim0); - limit = &FETCH_CHAR (lim0) - 1; - base = (cursor = &FETCH_CHAR (pos)); + start--; /* first character we scan */ + while (start > limit - 1) + { /* we WILL scan under start */ + ceiling = BUFFER_FLOOR_OF (start); + ceiling = max (limit, ceiling); + ceiling_addr = &FETCH_CHAR (ceiling) - 1; + base = (cursor = &FETCH_CHAR (start)); cursor++; while (1) { - while (--cursor != limit && *cursor != target) + while (--cursor != ceiling_addr && *cursor != target) ; - if (cursor != limit) + if (cursor != ceiling_addr) { - if (++cnt == 0) + if (++count == 0) { immediate_quit = 0; - return (pos + cursor - base + 1); + return (start + cursor - base + 1); } } else break; } - pos += cursor - base; + start += cursor - base; } } immediate_quit = 0; if (shortage != 0) - *shortage = cnt * direction; - return (pos + ((direction == 1 ? 0 : 1))); + *shortage = count * direction; + return (start + ((direction == 1 ? 0 : 1))); } int diff --git a/src/sysdep.c b/src/sysdep.c index 5f6090a246..51c5bd920a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -479,7 +479,7 @@ child_setup_tty (out) setpgrp_of_tty (pid) int pid; { - EMACS_SET_TTY_PGRP (input_fd, pid); + EMACS_SET_TTY_PGRP (input_fd, &pid); } /* Record a signal code and the handler for it. */ @@ -1199,7 +1199,7 @@ kbd_input_ast () { register int c = -1; int old_errno = errno; - extern int *input_available_clear_word; + extern EMACS_TIME *input_available_clear_time; if (waiting_for_ast) SYS$SETEF (input_ef); @@ -1236,8 +1236,8 @@ kbd_input_ast () kbd_buffer_store_event (&e); } - if (input_available_clear_word) - *input_available_clear_word = 0; + if (input_available_clear_time) + EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); errno = old_errno; } diff --git a/src/systty.h b/src/systty.h index 4bbf021595..910810dc15 100644 --- a/src/systty.h +++ b/src/systty.h @@ -61,6 +61,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef SYSV_PTYS #include +#ifdef titan +#include +#include +#endif #include #endif @@ -78,6 +82,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #undef TIOCSTART #endif +#ifdef XENIX +#undef TIOCGETC /* Avoid confusing some conditionals that test this. */ +#endif + #ifdef BROKEN_TIOCGETC #undef TIOCGETC /* Avoid confusing some conditionals that test this. */ #endif @@ -128,6 +136,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's current process group to *PGID. Return -1 if there is an error. */ +#ifdef HPUX +/* HPUX tty process group stuff doesn't work, says the anonymous voice + from the past. */ +#else #ifdef TIOCGPGRP #define EMACS_HAVE_TTY_PGRP #else @@ -135,6 +147,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #define EMACS_HAVE_TTY_PGRP #endif #endif +#endif #ifdef EMACS_HAVE_TTY_PGRP diff --git a/src/termhooks.h b/src/termhooks.h index ff1df84059..08c8e818e8 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -1,12 +1,12 @@ /* Hooks by which low level terminal operations can be made to call other routines. - Copyright (C) 1985, 1986 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -138,7 +138,7 @@ struct input_event { struct screen *screen; int modifiers; /* See enum below for interpretation. */ Lisp_Object x, y; - Lisp_Object timestamp; + unsigned long timestamp; }; /* Bits in the modifiers member of the input_event structure. */ diff --git a/src/xselect.c.old b/src/xselect.c.old index a8c26f7e99..a88208bece 100644 --- a/src/xselect.c.old +++ b/src/xselect.c.old @@ -1,11 +1,11 @@ /* X Selection processing for emacs - Copyright (C) 1990 Free Software Foundation. + Copyright (C) 1990, 1992 Free Software Foundation. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -32,6 +32,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* The last 23 bits of the timestamp of the last mouse button event. */ extern Time mouse_timestamp; +/* An expedient hack! Fix this! */ +#define last_event_timestamp CurrentTime + /* t if a mouse button is depressed. */ extern Lisp_Object Vmouse_grabbed; @@ -130,7 +133,7 @@ own_selection (selection_type, time) selecting_window, time); owner_window = XGetSelectionOwner (x_current_display, selection_type); - if (owner_window != selecting_window) + if (owner_window != selecting_window) return 0; return 1; @@ -160,7 +163,7 @@ but optional second argument TYPE may specify secondary or clipboard.") x_begin_selection_own = event_time; val = Vx_selection_value = string; } - UNBLOCK_INPUT; + UNBLOCK_INPUT; } else if (EQ (type, Qsecondary)) { @@ -177,10 +180,10 @@ but optional second argument TYPE may specify secondary or clipboard.") BLOCK_INPUT; if (own_selection (Xatom_clipboard, event_time)) { - x_begin_clipboard_own = event_time; + x_begin_clipboard_own = event_time; val = Vx_clipboard_value = string; } - UNBLOCK_INPUT; + UNBLOCK_INPUT; } else error ("Invalid X selection type"); @@ -545,7 +548,7 @@ selection, but optional argument TYPE may specify secondary or clipboard.") if (NILP (type) || EQ (type, Qprimary)) { if (!NILP (Vx_selection_value)) - return Vx_selection_value; + return Vx_selection_value; return get_selection_value (XA_PRIMARY); } -- 2.20.1