xemacs-beta: src/event-stream.c comparison

comparison src/event-stream.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.

author	ben
date	Tue, 28 May 2002 08:45:36 +0000
parents	e7ee5f8bde58
children	804517e16990

comparison

equal deleted inserted replaced

-:d83885ef293b
+:2b6fa2618f76
 return 1;
 }
 return 0;
 }
-void
+static void
 event_stream_next_event (Lisp_Event *event)
 {
 Lisp_Object event_obj;
 check_event_stream_ok (EVENT_STREAM_READ);
 event_obj = wrap_event (event);
 zero_event (event);
-/* If C-g was pressed, treat it as a character to be read.
+/* SIGINT occurs when C-g was pressed on a TTY. (SIGINT might have
-Note that if C-g was pressed while we were blocking,
+been sent manually by the user, but we don't care; we treat it
-the SIGINT signal handler will be called.  It will
+the same.)
-set Vquit_flag and write a byte on our "fake pipe",
-which will unblock us. */
+The SIGINT signal handler sets Vquit_flag as well as sigint_happened
+and write a byte on our "fake pipe", which unblocks us when we are
+waiting for an event. */
+/* If SIGINT was received after we disabled quit checking (because
+we want to read C-g's as characters), but before we got a chance
+to start reading, notice it now and treat it as a character to be
+read.  If above callers wanted this to be QUIT, they can
+determine this by comparing the event against quit-char. */
 if (maybe_read_quit_event (event))
 {
 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
 return;
 }
 Let's hope it doesn't.  I think the code here is fairly
 clean and doesn't do this. */
 emacs_is_blocking = 1;
 event_stream->next_event_cb (event);
 emacs_is_blocking = 0;
+/* Now check to see if C-g was pressed while we were blocking.
+We treat it as an event, just like above. */
+if (maybe_read_quit_event (event))
+{
+DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
+return;
+}
 #ifdef DEBUG_XEMACS
 /* timeout events have more info set later, so
 print the event out in next_event_internal(). */
 if (event->event_type != timeout_event)
 con->input_enabled = 0;
 }
 }
 void
-event_stream_select_process (Lisp_Process *proc)
+event_stream_select_process (Lisp_Process *proc, int doin, int doerr)
 {
+int cur_in, cur_err;
 check_event_stream_ok (EVENT_STREAM_PROCESS);
-if (!get_process_selected_p (proc))
-{
+cur_in = get_process_selected_p (proc, 0);
-event_stream->select_process_cb (proc);
+if (cur_in)
-set_process_selected_p (proc, 1);
+doin = 0;
+if (!process_has_separate_stderr (wrap_process (proc)))
+{
+doerr = 0;
+cur_err = 0;
+}
+else
+{
+cur_err = get_process_selected_p (proc, 1);
+if (cur_err)
+	doerr = 0;
+}
+if (doin || doerr)
+{
+event_stream->select_process_cb (proc, doin, doerr);
+set_process_selected_p (proc, cur_in || doin, cur_err || doerr);
 }
 }
 void
-event_stream_unselect_process (Lisp_Process *proc)
+event_stream_unselect_process (Lisp_Process *proc, int doin, int doerr)
 {
+int cur_in, cur_err;
 check_event_stream_ok (EVENT_STREAM_PROCESS);
-if (get_process_selected_p (proc))
-{
+cur_in = get_process_selected_p (proc, 0);
-event_stream->unselect_process_cb (proc);
+if (!cur_in)
-set_process_selected_p (proc, 0);
+doin = 0;
-}
-}
+if (!process_has_separate_stderr (wrap_process (proc)))
+{
-USID
+doerr = 0;
-event_stream_create_stream_pair (void *inhandle, void *outhandle,
+cur_err = 0;
-		Lisp_Object *instream, Lisp_Object *outstream, int flags)
+}
+else
+{
+cur_err = get_process_selected_p (proc, 1);
+if (!cur_err)
+	doerr = 0;
+}
+if (doin || doerr)
+{
+event_stream->unselect_process_cb (proc, doin, doerr);
+set_process_selected_p (proc, cur_in && !doin, cur_err && !doerr);
+}
+}
+void
+event_stream_create_io_streams (void *inhandle, void *outhandle,
+				void *errhandle, Lisp_Object *instream,
+				Lisp_Object *outstream,
+				Lisp_Object *errstream,
+				USID *in_usid,
+				USID *err_usid,
+				int flags)
 {
 check_event_stream_ok (EVENT_STREAM_PROCESS);
-return event_stream->create_stream_pair_cb
+event_stream->create_io_streams_cb
-		(inhandle, outhandle, instream, outstream, flags);
+(inhandle, outhandle, errhandle, instream, outstream, errstream,
-}
+in_usid, err_usid, flags);
+}
-USID
-event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
+void
+event_stream_delete_io_streams (Lisp_Object instream,
+				Lisp_Object outstream,
+				Lisp_Object errstream,
+				USID *in_usid,
+				USID *err_usid)
 {
 check_event_stream_ok (EVENT_STREAM_PROCESS);
-return event_stream->delete_stream_pair_cb (instream, outstream);
+event_stream->delete_io_streams_cb (instream, outstream, errstream,
+				      in_usid, err_usid);
 }
 void
 event_stream_quit_p (void)
 {
 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
 {
 /* This function can GC */
 double echo_keystrokes;
 struct frame *f = selected_frame ();
+int depth = begin_dont_check_for_quit ();
 /* Message turns off echoing unless more keystrokes turn it on again. */
 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
-return;
+goto done;
 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
 echo_keystrokes = extract_float (Vecho_keystrokes);
 else
 echo_keystrokes = 0;
 #endif
 )
 {
 if (!no_snooze)
 	{
-	  /* #### C-g here will cause QUIT.  Setting dont_check_for_quit
-	     doesn't work.  See check_quit. */
 	  if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
 	    /* input came in, so don't echo. */
-	    return;
+	    goto done;
 	}
 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
 			 /* not echo_buf_index.  That doesn't include
 			    the terminating " - ". */
 			 strlen ((char *) command_builder->echo_buf),
 			 Qcommand);
 }
+done:
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
 }
 static void
 reset_key_echo (struct command_builder *command_builder,
 int remove_echo_area_echo)
 dequeue_command_event (void)
 {
 return dequeue_event (&command_event_queue, &command_event_queue_tail);
 }
-/* put the event on the typeahead queue, unless
-the event is the quit char, in which case the `QUIT'
-which will occur on the next trip through this loop is
-all the processing we should do - leaving it on the queue
-would cause the quit to be processed twice.
-*/
 static void
 enqueue_command_event_1 (Lisp_Object event_to_copy)
 {
-/* do not call check_quit() here.  Vquit_flag was set in
+enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
-next_event_internal. */
-if (NILP (Vquit_flag))
-enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
 }
 void
 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
 {
 }
 /* the number of keyboard characters read.  callint.c wants this. */
 Charcount num_input_chars;
+/* Read an event from the window system (or tty).  If ALLOW_QUEUED is
+non-zero, read from the command-event queue first.
+If C-g was pressed, this function will attempt to QUIT.  If you want
+to read C-g as an event, wrap this function with a call to
+begin_dont_check_for_quit(), and set Vquit_flag to Qnil just before
+you unbind.  In this case, TARGET_EVENT will contain a C-g.
+Note that even if you are interested in C-g doing QUIT, a caller of you
+might not be.
+*/
 static void
 next_event_internal (Lisp_Object target_event, int allow_queued)
 {
 struct gcpro gcpro1;
-/* QUIT;   This is incorrect - the caller must do this because some
+QUIT;
-	     callers (ie, Fnext_event()) do not want to QUIT. */
 assert (NILP (XEVENT_NEXT (target_event)));
 GCPRO1 (target_event);
 	  /* next_event_internal() doesn't print out timeout events
 	     because of the extra info we just set. */
 	  DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
 	}
-/* If we read a ^G, then set quit-flag but do not discard the ^G.
+/* If we read a ^G, then set quit-flag and try to QUIT.
-	 The callers of next_event_internal() will do one of two things:
+	 This may be blocked (see above).
-	 -- set Vquit_flag to Qnil. (next-event does this.) This will
-	    cause the ^G to be treated as a normal keystroke.
-	 -- not change Vquit_flag but attempt to enqueue the ^G, at
-	    which point it will be discarded.  The next time QUIT is
-	    called, it will notice that Vquit_flag was set.
 */
 if (e->event_type == key_press_event &&
 	  event_matches_key_specifier_p
 	  (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
 	{
 	  Vquit_flag = Qt;
+	  QUIT;
 	}
 }
 UNGCPRO;
 }
-static void
+void
 run_pre_idle_hook (void)
 {
 if (!NILP (Vpre_idle_hook)
 && !detect_input_pending ())
-safe_run_hook_trapping_errors
+safe_run_hook_trapping_problems
 ("Error in `pre-idle-hook' (setting hook to nil)",
-Qpre_idle_hook, 1);
+Qpre_idle_hook, INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
 }
 static void push_this_command_keys (Lisp_Object event);
 static void push_recent_keys (Lisp_Object event);
 static void dribble_out_event (Lisp_Object event);
 struct console *con = XCONSOLE (Vselected_console);
 struct command_builder *command_builder =
 XCOMMAND_BUILDER (con->command_builder);
 int store_this_key = 0;
 struct gcpro gcpro1;
+int depth;
 GCPRO1 (event);
-/* DO NOT do QUIT anywhere within this function or the functions it calls.
-We want to read the ^G as an event. */
+depth = begin_dont_check_for_quit ();
 #ifdef LWLIB_MENUBARS_LUCID
 /*
 * #### Fix the menu code so this isn't necessary.
 *
 	  Lisp_Object e = XCAR (Vunread_command_events);
 	  Vunread_command_events = XCDR (Vunread_command_events);
 	  if (!EVENTP (e) || !command_event_p (e))
 	    signal_error_1 (Qwrong_type_argument,
 			  list3 (Qcommand_event_p, e, Qunread_command_events));
-	  redisplay ();
+	  redisplay_no_pre_idle_hook ();
 	  if (!EQ (e, event))
 	    Fcopy_event (e, event);
 	  DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
 	}
 }
 	  signal_error_1 (Qwrong_type_argument,
 			list3 (Qeventp, e, Qunread_command_event));
 	}
 if (!EQ (e, event))
 	Fcopy_event (e, event);
-redisplay ();
+redisplay_no_pre_idle_hook ();
 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
 }
 /* If we're executing a keyboard macro, take the next event from that,
 and update this-command-keys and recent-keys.
 */
 else
 {
 if (!NILP (Vexecuting_macro))
 	{
-	  redisplay ();
+	  redisplay_no_pre_idle_hook ();
 	  pop_kbd_macro_event (event);  /* This throws past us at
 					   end-of-macro. */
 	  store_this_key = 1;
 	  DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
 	}
 /* Otherwise, read a real event, possibly from the
 	 command_event_queue, and update this-command-keys and
 	 recent-keys. */
 else
 	{
-	  run_pre_idle_hook ();
 	  redisplay ();
 	  next_event_internal (event, 1);
-	  Vquit_flag = Qnil; /* Read C-g as an event. */
 	  store_this_key = 1;
 	}
 }
+/* temporarily reenable quit checking here, because arbitrary lisp
+is executed */
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
 status_notify ();             /* Notice process change */
+depth = begin_dont_check_for_quit ();
 /* Since we can free the most stuff here
 *  (since this is typically called from
 *  the command-loop top-level). */
 if (need_to_check_c_alloca)
 goto STORE_AND_EXECUTE_KEY;
 case key_press_event:         /* any key input can trigger autosave */
 break;
 }
+/* temporarily reenable quit checking here, because we could get stuck */
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
 maybe_do_auto_save ();
+depth = begin_dont_check_for_quit ();
 num_input_chars++;
 STORE_AND_EXECUTE_KEY:
 if (store_this_key)
 {
 echo_key_event (command_builder, event);
 	  if (!EVENTP (command_builder->current_events))
 	    finalize_kbd_macro_chars (con);
 	  store_kbd_macro_event (event);
 	}
 }
-/* If this is the help char and there is a help form, then execute the
+/* If this is the help char and there is a help form, then execute
-help form and swallow this character.  This is the only place where
+the help form and swallow this character.  Note that
-calling Fnext_event() can cause arbitrary lisp code to run.  Note
+execute_help_form() calls Fnext_command_event(), which calls this
-that execute_help_form() calls Fnext_command_event(), which calls
+function, as well as Fdispatch_event.  */
-this function, as well as Fdispatch_event.
-*/
 if (!NILP (Vhelp_form) &&
 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
-execute_help_form (command_builder, event);
+{
+/* temporarily reenable quit checking here, because we could get stuck */
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
+execute_help_form (command_builder, event);
+depth = begin_dont_check_for_quit ();
+}
 RETURN:
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
 UNGCPRO;
 return event;
 }
 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
 Return the next available "user" event.
 (event, prompt))
 {
 /* This function can GC */
 struct gcpro gcpro1;
 GCPRO1 (event);
 maybe_echo_keys (XCOMMAND_BUILDER
 		   (XCONSOLE (Vselected_console)->
 		    command_builder), 0); /* #### This sucks bigtime */
 for (;;)
 {
 event = Fnext_event (event, prompt);
 if (command_event_p (event))
 break;
 time. */
 event_stream_force_event_pending (selected_frame ());
 while (event_stream_event_pending_p (0))
 {
-QUIT; /* next_event_internal() does not QUIT. */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  Also, we have no reason to consult the
 	 command_event_queue; there are only user and eval-events there,
 	 and we'd just have to put them back anyway.
 */
 next_event_internal (event, 0); /* blocks */
-/* See the comment in accept-process-output about Vquit_flag */
 if (XEVENT_TYPE (event) == magic_event ||
 	  XEVENT_TYPE (event) == timeout_event ||
 	  XEVENT_TYPE (event) == process_event ||
 	  XEVENT_TYPE (event) == pointer_motion_event)
 	execute_internal_event (event);
 /* This throws away user-input on the queue, but doesn't process any
 events.  Calling dispatch_event() here leads to a race condition.
 */
 Lisp_Object event = Fmake_event (Qnil, Qnil);
 Lisp_Object head = Qnil, tail = Qnil;
-Lisp_Object oiq = Vinhibit_quit;
+struct gcpro gcpro1;
-struct gcpro gcpro1, gcpro2;
 /* #### not correct here with Vselected_console?  Should
 discard-input take a console argument, or maybe map over
 all consoles? */
 struct console *con = XCONSOLE (Vselected_console);
 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
-GCPRO2 (event, oiq);
+GCPRO1 (event);
-Vinhibit_quit = Qt;
 /* If a macro was being defined then we have to mark the modeline
 has changed to ensure that it gets updated correctly. */
 if (!NILP (con->defining_kbd_macro))
 MARK_MODELINE_CHANGED;
 con->defining_kbd_macro = Qnil;
 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
 while (!NILP (command_event_queue)
 || event_stream_event_pending_p (1))
 {
+/* We want to ignore C-g's along with all other keypresses. */
+int depth = begin_dont_check_for_quit ();
 /* This will take stuff off the command_event_queue, or read it
 	 from the event_stream, but it will not block.
 */
 next_event_internal (event, 1);
-Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
+/* The following comment used to be here:
-			    It is vitally important that we reset
-			    Vquit_flag here.  Otherwise, if we're
+	 [[Treat C-g as a user event (ignore it).  It is vitally
-			    reading from a TTY console,
+	 important that we reset Vquit_flag here.  Otherwise, if we're
-			    maybe_read_quit_event() will notice
+	 reading from a TTY console, maybe_read_quit_event() will
-			    that C-g has been set and send us
+	 notice that C-g has been set and send us another C-g.  That
-			    another C-g.  That will cause us
+	 will cause us to get right back here, and read another C-g,
-			    to get right back here, and read
+	 ad infinitum ...]]
-			    another C-g, ad infinitum ... */
+but I don't think this is correct; maybe_read_quit_event()
+checks and resets sigint_happened.  It shouldn't matter if we
+	 reset here or outside of the while loop. --ben */
+Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
+unbind_to (depth);
 /* If the event is a user event, ignore it. */
 if (!command_event_p (event))
 	{
 	  /* Otherwise, chain the event onto our list of events not to ignore,
 command_event_queue_tail = tail;
 Fdeallocate_event (event);
 UNGCPRO;
-Vinhibit_quit = oiq;
 return Qnil;
 }
 /**********************************************************************/
 	  timeout_enabled = 0;
 done = 1;             /* We're  done. */
 continue;             /* Don't call next_event_internal */
 	}
-QUIT;	/* next_event_internal() does not QUIT, so check for ^G
-		   before reading output from the process - this makes it
-		   less likely that the filter will actually be aborted.
-		 */
 next_event_internal (event, 0);
-/* If C-g was pressed while we were waiting, Vquit_flag got
-	 set and next_event_internal() also returns C-g.  When
-	 we enqueue the C-g below, it will get discarded.  The
-	 next time through, QUIT will be called and will signal a quit. */
 switch (XEVENT_TYPE (event))
 	{
 	case process_event:
 	  {
 	    if (NILP (process) ||
 }
 unbind_to_1 (count, timeout_enabled ? make_int (timeout_id) : Qnil);
 Fdeallocate_event (event);
+status_notify ();
 UNGCPRO;
 current_buffer = old_buffer;
 return result;
 }
 {
 /* If our timeout has arrived, we move along. */
 if (!event_stream_wakeup_pending_p (id, 0))
 	goto DONE_LABEL;
-QUIT;	/* next_event_internal() does not QUIT, so check for ^G
-		   before reading output from the process - this makes it
-		   less likely that the filter will actually be aborted.
-		 */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  We don't care about command and eval-events
 	 anyway.
 */
 next_event_internal (event, 0); /* blocks */
-/* See the comment in accept-process-output about Vquit_flag */
 switch (XEVENT_TYPE (event))
 	{
 	case timeout_event:
 	  /* We execute the event even if it's ours, and notice that it's
 	     happened above. */
 don't wait. */
 if (noninteractive || !NILP (Vexecuting_macro))
 return Qnil;
 /* Recursive call from a filter function or timeout handler. */
-if (!NILP(recursive_sit_for))
+if (!NILP (recursive_sit_for))
 {
 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
-	{
-	  run_pre_idle_hook ();
 	  redisplay ();
-	}
 return Qnil;
 }
 /* Otherwise, start reading events from the event_stream.
 while (1)
 {
 /* If there is no user input pending, then redisplay.
 */
 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
-	{
-	  run_pre_idle_hook ();
 	  redisplay ();
-	}
 /* If our timeout has arrived, we move along. */
 if (!event_stream_wakeup_pending_p (id, 0))
 	{
 	  result = Qt;
 	  goto DONE_LABEL;
 	}
-QUIT;	/* next_event_internal() does not QUIT, so check for ^G
-		   before reading output from the process - this makes it
-		   less likely that the filter will actually be aborted.
-		 */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  In fact, we know there's nothing on the
 	 command_event_queue that we didn't just put there.
 */
 next_event_internal (event, 0); /* blocks */
-/* See the comment in accept-process-output about Vquit_flag */
 if (command_event_p (event))
 	{
-	  QUIT;			/* If the command was C-g check it here
-				   so that we abort out of the sit-for,
-				   not the next command.  sleep-for and
-				   accept-process-output continue looping
-				   so they check QUIT again implicitly.*/
 	  result = Qnil;
 	  goto DONE_LABEL;
 	}
 switch (XEVENT_TYPE (event))
 	{
 struct gcpro gcpro1;
 GCPRO1 (event);
 while (!(*predicate) (predicate_arg))
 {
-QUIT; /* next_event_internal() does not QUIT. */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  Also, we have no reason to consult the
 	 command_event_queue; there are only user and eval-events there,
 	 and we'd just have to put them back anyway.
 */
 next_event_internal (event, 0);
-/* See the comment in accept-process-output about Vquit_flag */
 if (command_event_p (event)
 || (XEVENT_TYPE (event) == eval_event)
 	  || (XEVENT_TYPE (event) == magic_eval_event))
 enqueue_command_event_1 (event);
 else
 case process_event:
 {
 	Lisp_Object p = XEVENT (event)->event.process.process;
 	Charcount readstatus;
+	int iter;
-	assert  (PROCESSP (p));
-	while ((readstatus = read_process_output (p)) > 0)
+	assert (PROCESSP (p));
-	  ;
+	for (iter = 0; iter < 2; iter++)
-	if (readstatus > 0)
+	  {
-	  ; /* this clauses never gets executed but allows the #ifdefs
+	    if (iter == 1 && !process_has_separate_stderr (p))
-	       to work cleanly. */
+	      break;
+	    while ((readstatus = read_process_output (p, iter)) > 0)
+	      ;
+	    if (readstatus > 0)
+	      ;			/* this clauses never gets executed but
+				   allows the #ifdefs to work cleanly. */
 #ifdef EWOULDBLOCK
-	else if (readstatus == -1 && errno == EWOULDBLOCK)
+	    else if (readstatus == -1 && errno == EWOULDBLOCK)
-	  ;
+	      ;
 #endif /* EWOULDBLOCK */
 #ifdef EAGAIN
-	else if (readstatus == -1 && errno == EAGAIN)
+	    else if (readstatus == -1 && errno == EAGAIN)
-	  ;
+	      ;
 #endif /* EAGAIN */
-	else if ((readstatus == 0 &&
+	    else if ((readstatus == 0 &&
-		  /* Note that we cannot distinguish between no input
+		      /* Note that we cannot distinguish between no input
-		     available now and a closed pipe.
+			 available now and a closed pipe.
-		     With luck, a closed pipe will be accompanied by
+			 With luck, a closed pipe will be accompanied by
-		     subprocess termination and SIGCHLD.  */
+			 subprocess termination and SIGCHLD.  */
-		  (!network_connection_p (p) ||
+		      (!network_connection_p (p) ||
-		   /*
+		       /*
-		      When connected to ToolTalk (i.e.
+			  When connected to ToolTalk (i.e.
-		      connected_via_filedesc_p()), it's not possible to
+			  connected_via_filedesc_p()), it's not possible to
-		      reliably determine whether there is a message
+			  reliably determine whether there is a message
-		      waiting for ToolTalk to receive.  ToolTalk expects
+			  waiting for ToolTalk to receive.  ToolTalk expects
-		      to have tt_message_receive() called exactly once
+			  to have tt_message_receive() called exactly once
-		      every time the file descriptor becomes active, so
+			  every time the file descriptor becomes active, so
-		      the filter function forces this by returning 0.
+			  the filter function forces this by returning 0.
-		      Emacs must not interpret this as a closed pipe. */
+			  Emacs must not interpret this as a closed pipe. */
-		   connected_via_filedesc_p (XPROCESS (p))))
+		       connected_via_filedesc_p (XPROCESS (p))))
-		 /* On some OSs with ptys, when the process on one end of
+		     /* On some OSs with ptys, when the process on one end of
-		    a pty exits, the other end gets an error reading with
+			a pty exits, the other end gets an error reading with
-		    errno = EIO instead of getting an EOF (0 bytes read).
+			errno = EIO instead of getting an EOF (0 bytes read).
-		    Therefore, if we get an error reading and errno =
+			Therefore, if we get an error reading and errno =
-		    EIO, just continue, because the child process has
+			EIO, just continue, because the child process has
-		    exited and should clean itself up soon (e.g. when we
+			exited and should clean itself up soon (e.g. when we
-		    get a SIGCHLD). */
+			get a SIGCHLD). */
 #ifdef EIO
-		 || (readstatus == -1 && errno == EIO)
+		     || (readstatus == -1 && errno == EIO)
 #endif
-		 )
+		     )
-	  {
+	      {
-	    /* Currently, we rely on SIGCHLD to indicate that the
+		/* Currently, we rely on SIGCHLD to indicate that the
-	       process has terminated.  Unfortunately, on some systems
+		   process has terminated.  Unfortunately, on some systems
-	       the SIGCHLD gets missed some of the time.  So we put an
+		   the SIGCHLD gets missed some of the time.  So we put an
-	       additional check in status_notify() to see whether a
+		   additional check in status_notify() to see whether a
-	       process has terminated.  We must tell status_notify()
+		   process has terminated.  We must tell status_notify()
-	       to enable that check, and we do so now. */
+		   to enable that check, and we do so now. */
-	    kick_status_notify ();
+		kick_status_notify ();
+	      }
+	    /* We must call status_notify here to allow the
+	       event_stream->unselect_process_cb to be run if appropriate.
+	       Otherwise, dead fds may be selected for, and we will get a
+	       continuous stream of process events for them.  Since we don't
+	       return until all process events have been flushed, we would
+	       get stuck here, processing events on a process whose status
+	       was 'exit.  Call this after dispatch-event, or the fds will
+	       have been closed before we read the last data from them.
+	       It's safe for the filter to signal an error because
+	       status_notify() will be called on return to top-level.
+	    */
+	    status_notify ();
+	    return;
 	  }
-	else
-	  {
-	    /* Deactivate network connection */
-	    Lisp_Object status = Fprocess_status (p);
-	    if (EQ (status, Qopen)
-		/* In case somebody changes the theory of whether to
-		   return open as opposed to run for network connection
-		   "processes"... */
-		|| EQ (status, Qrun))
-	      update_process_status (p, Qexit, 256, 0);
-	    deactivate_process (p);
-	  }
-	/* We must call status_notify here to allow the
-	   event_stream->unselect_process_cb to be run if appropriate.
-	   Otherwise, dead fds may be selected for, and we will get a
-	   continuous stream of process events for them.  Since we don't
-	   return until all process events have been flushed, we would
-	   get stuck here, processing events on a process whose status
-	   was 'exit.  Call this after dispatch-event, or the fds will
-	   have been closed before we read the last data from them.
-	   It's safe for the filter to signal an error because
-	   status_notify() will be called on return to top-level.
-	   */
-	status_notify ();
-	return;
 }
 case timeout_event:
 {
 	Lisp_Event *e = XEVENT (event);
 		maybe_echo_keys (command_builder, 1);
 	      }
 	    else
 	      maybe_echo_keys (command_builder, 0);
 	  }
+	/* #### i don't trust this at all. --ben */
+#if 0
 	else if (!NILP (Vquit_flag))
 	  {
 	    Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
 	    Lisp_Event *e = XEVENT (quit_event);
 	    /* if quit happened during menu acceleration, pretend we read it */
 	    e->channel = wrap_console (con);
 	    enqueue_command_event (quit_event);
 	    Vquit_flag = Qnil;
 	  }
+#endif
 }
 else if (!NILP (leaf))
 {
 	if (EQ (Qcommand, echo_area_status (f))
 	    && command_builder->echo_buf_index > 0)
 pre_command_hook (void)
 {
 last_point_position = BUF_PT (current_buffer);
 last_point_position_buffer = wrap_buffer (current_buffer);
 /* This function can GC */
-safe_run_hook_trapping_errors
+safe_run_hook_trapping_problems
 ("Error in `pre-command-hook' (setting hook to nil)",
-Qpre_command_hook, 1);
+Qpre_command_hook, INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
 /* This is a kludge, but necessary; see simple.el */
 call0 (Qhandle_pre_motion_command);
 }
 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
 zmacs_deactivate_region ();
 else
 zmacs_update_region ();
-safe_run_hook_trapping_errors
+safe_run_hook_trapping_problems
 ("Error in `post-command-hook' (setting hook to nil)",
-Qpost_command_hook, 1);
+Qpost_command_hook, INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
+#if 0 /* FSF Emacs crap */
+if (!NILP (Vdeferred_action_list))
+call0 (Vdeferred_action_function);
+if (NILP (Vunread_command_events)
+&& NILP (Vexecuting_macro)
+&& !NILP (Vpost_command_idle_hook)
+&& !NILP (Fsit_for (make_float ((double) post_command_idle_delay
+				      / 1000000), Qnil)))
+safe_run_hook_trapping_problems
+("Error in `post-command-idle-hook' (setting hook to nil)",
+Qpost_command_idle_hook,
+INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
+#endif /* FSF Emacs crap */
+#if 0 /* FSF Emacs */
+if (!NILP (current_buffer->mark_active))
+{
+if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
+{
+current_buffer->mark_active = Qnil;
+	  run_hook (intern ("deactivate-mark-hook"));
+}
+else if (current_buffer != prev_buffer ||
+	       BUF_MODIFF (current_buffer) != prev_modiff)
+	run_hook (intern ("activate-mark-hook"));
+}
+#endif /* FSF Emacs */
 /* #### Kludge!!! This is necessary to make sure that things
 are properly positioned even if post-command-hook moves point.
 #### There should be a cleaner way of handling this. */
 call0 (Qauto_show_make_point_visible);
 QUIT;
 if (NILP (continue_echo))
 reset_this_command_keys (wrap_console (con), 1);
-specbind (Qinhibit_quit, Qt);
 if (!NILP (dont_downcase_last))
 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
 for (;;)
 {
 	    }
 	  prompt = Qnil;
 	}
 }
-Vquit_flag = Qnil;  /* In case we read a ^G; do not call check_quit() here */
 Fdeallocate_event (event);
 RETURN_UNGCPRO (unbind_to_1 (speccount, result));
 }
 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
 Function or functions to run before every command.
 This may examine the `this-command' variable to find out what command
 is about to be run, or may change it to cause a different command to run.
-Function on this hook must be careful to avoid signalling errors!
+Errors while running the hook are caught and turned into warnings.
 */ );
 Vpre_command_hook = Qnil;
 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
 Function or functions to run after every command.
 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
 Normal hook run when XEmacs it about to be idle.
 This occurs whenever it is going to block, waiting for an event.
 This generally happens as a result of a call to `next-event',
 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
-or `x-get-selection'.
+or `get-selection'.  Errors while running the hook are caught and
-Errors running the hook are caught and ignored.
+turned into warnings.
 */ );
 Vpre_idle_hook = Qnil;
 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
 *Variable to control XEmacs behavior with respect to focus changing.
 }
 }
 /*
+#### this comment is at least 8 years old and some may no longer apply.
 useful testcases for v18/v19 compatibility:
 (defun foo ()
 (interactive)
 (setq unread-command-event (character-to-event ?A (allocate-event)))

Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 853:2b6fa2618f76