summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJim Blandy <jimb@redhat.com>1992-05-18 08:14:41 +0000
committerJim Blandy <jimb@redhat.com>1992-05-18 08:14:41 +0000
commitffd56f97cf56501f7a6981c184192e9043e4eafd (patch)
treed463f4585c85fa76b33d3663271bbb4126d7b116 /src
parent502ddf238f0ed280a301426804b2ed16ec1c49cc (diff)
downloademacs-ffd56f97cf56501f7a6981c184192e9043e4eafd.tar.gz
emacs-ffd56f97cf56501f7a6981c184192e9043e4eafd.tar.bz2
emacs-ffd56f97cf56501f7a6981c184192e9043e4eafd.zip
*** empty log message ***
Diffstat (limited to 'src')
-rw-r--r--src/.gdbinit1
-rw-r--r--src/alloc.c12
-rw-r--r--src/buffer.c45
-rw-r--r--src/callint.c7
-rw-r--r--src/callproc.c36
-rw-r--r--src/data.c78
-rw-r--r--src/editfns.c45
-rw-r--r--src/eval.c62
-rw-r--r--src/fileio.c2
-rw-r--r--src/keyboard.c39
-rw-r--r--src/lisp.h4
-rw-r--r--src/minibuf.c6
-rw-r--r--src/process.c84
-rw-r--r--src/search.c80
-rw-r--r--src/sysdep.c8
-rw-r--r--src/systty.h13
-rw-r--r--src/termhooks.h6
-rw-r--r--src/xselect.c.old17
18 files changed, 305 insertions, 240 deletions
diff --git a/src/.gdbinit b/src/.gdbinit
index 55000f571eb..91a921119e8 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 9b7da1d0f5b..9c63f8fe132 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 fbf6bb8b611..de9e4246f80 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 88c16721116..aeb6ef38720 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 9544ecf0a21..85fbcf7c784 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 4e95494d593..df85ef254ea 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 0ef059aa055..6164ef32799 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 c4fcc808c5d..ab0ae207f2c 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 f977ee0c623..a317db7c69f 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 <sys/types.h>
#include <sys/stat.h>
@@ -52,7 +53,6 @@ extern int sys_nerr;
#include <sys/time.h>
#endif
-#include "config.h"
#include "lisp.h"
#include "buffer.h"
#include "window.h"
diff --git a/src/keyboard.c b/src/keyboard.c
index e6139cfaf11..5b0d5facfc6 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 b263370dac6..b0b0cb4fc56 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 93c9f26727a..df45dac7483 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 9ba48ef7d56..68bdfa334e6 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 <bsdtty.h>
#endif
-#ifdef HPUX
-#undef TIOCGPGRP
-#endif
-
#ifdef IRIS
#include <sys/sysmacros.h> /* for "minor" */
#endif /* not IRIS */
#include "systime.h"
-
-#if defined (HPUX) && defined (HAVE_PTYS)
-#include <sys/ptyio.h>
-#endif
-
-#ifdef AIX
-#include <sys/pty.h>
-#include <unistd.h>
-#endif
-
-#ifdef SYSV_PTYS
-#include <sys/tty.h>
-#ifdef titan
-#include <sys/ttyhw.h>
-#include <sys/stream.h>
-#endif
-#include <sys/pty.h>
-#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 9ac63aea874..5f1f17f2d53 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 5f6090a2460..51c5bd920a7 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 4bbf021595d..910810dc15d 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 <sys/tty.h>
+#ifdef titan
+#include <sys/ttyhw.h>
+#include <sys/stream.h>
+#endif
#include <sys/pty.h>
#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 ff1df84059d..08c8e818e80 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 a8c26f7e994..a88208bece9 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);
}