Once again, this is a big glump of various different things. However,
there are fewer different things here than the last one. In the future,
I'm going to try and avoid doing so much because it's just too wearing
on my hands. The result is you'll probably get fewer and fewer glumped
together items, as necessity calls and I force some discipline on
myself.
This glump includes approximately:
-- overhaul of all foo_trapping_errors() functions to issue backtraces
in the warning buffer, be more robust,
and do more things as controlled by flags (catch aberrant throws,
inhibit gc, inhibit quit, etc.). With a bit
more extension, these could be used to *completely safely* call Lisp
from within redisplay.
-- major process changes; specifically,
-- stdout can be separated from stderr.
-- some process bugs fixed under mswin.
-- new implementation of call-process in lisp. (needs a bit of work,
esp. testing; currently only enabled for
mswindows, where existing call-process is totally broken.)
-- msw dialog boxes now accept keystrokes (tab, spc, enter, etc.)
-- there is now a Lisp menu in Lisp Interaction mode.
-- msw_ -> mswindows_
-- stat warnings fixed
-- new feature: mark-ring-unrecorded-commands, so your mark ring isn't
littered with marks from
simple selection commands.
-- sys_readlink() is Mule-ized.
-- pre-idle-hook is now run all the times it should be.
Issues:
(1)
What it does NOT include are proper ChangeLogs. I ran out of steam
before I could deal with them. I may try to do something about this
before I go to Japan, but I would really appreciate it if someone could
help me with them. (Hrvoje? Perhaps Martin?) What you see below are
auto-generated logs using the script `patch-to-changelog', a concoction
of Martin and me.
(2)
It's probably broken under Unix, in particular the process section. It
does work under Windows, meaning any breakage is in the Unix-specific
stuff. Hopefully, when any compile errors are ironed it, it should work
fine under Unix when the new stderr stuff is not enabled, and if we're
lucky, that will work too. If not, the fixes should be relatively
easy. Someone (Martin?) want to look into this?
(3)
My call-process implementation needs testing on all the myriad different
possible argument values to `call-process'. Adrian, perhaps?
(4)
Andy, please don't reindent entire files! At least give some very
prominent warning and wait before doing so. I had a major headache with
event-msw.c, since I had made so many changes and CVS totally trashed my
working copy attempting to merge. Luckily, I had a recent backup, so I
basically extracted your non-whitespace changes, applied them to the
recent backup, and then reimplemented the stuff I had put in since the
last backup.
(5)
Eventually, my Lisp implementation of call-process will be the only one,
and the existing stuff in callproc.c will mostly just go away. However,
that requires (on top of testing and bug fixing) that the new version
work in batch mode, which (I think) it doesn't currently, because
there's no real event loop there. Kirill said he would fix this at some
point. Perhaps now's the time?
ben
ChangeLog:
@@ -1,3 1,7 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* etc/NEWS (MS-Windows):
lisp/ChangeLog:
@@ -1,3 1,22 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* lisp-mode.el:
* lisp-mode.el (lisp-interaction-mode-menubar-menu): New.
* lisp-mode.el (lisp-interaction-mode):
* process.el:
* process.el (call-process-internal): New.
* simple.el:
* simple.el (mark-ring):
* simple.el (dont-record-current-mark): New.
* simple.el (in-shifted-motion-command): New.
* simple.el (mark-ring-unrecorded-commands): New.
* simple.el (mark-ring-max):
* simple.el (set-mark-command):
* simple.el (push-mark):
* simple.el (handle-pre-motion-command):
* subr.el:
* subr.el (function-allows-args): New.
nt/ChangeLog:
@@ -1,3 1,8 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* README:
* xemacs.mak (TEMACS_DUMP_OBJS):
src/ChangeLog:
@@ -1,3 1,229 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* alloc.c (garbage_collect_1):
* backtrace.h:
* backtrace.h (SPECBIND):
* backtrace.h (SPECBIND_FAST_UNSAFE):
* backtrace.h (UNBIND_TO_GCPRO):
* backtrace.h (UNBIND_TO):
* backtrace.h (UNBIND_TO_GCPRO_VARIABLES_ONLY):
* bytecode.c (execute_optimized_program):
* bytecode.c (execute_rare_opcode):
* callproc.c:
* callproc.c (syms_of_callproc):
* cmdloop.c (initial_command_loop):
* cmdloop.c (Frecursive_edit):
* cmdloop.c (call_command_loop):
* console-msw.c:
* console-msw.c (mswindows_get_console_hwnd):
* console-msw.c (mswindows_hide_console):
* console-msw.c (mswindows_show_console):
* console-msw.c (mswindows_ensure_console_buffered):
* console-msw.c (mswindows_windows9x_p):
* console-msw.h:
* device-msw.c (mswindows_get_workspace_coords):
* device-msw.c (mswindows_device_system_metrics):
* dialog-msw.c:
* dialog-msw.c (mswindows_is_dialog_msg):
* dialog-msw.c (dialog_proc):
* dialog-msw.c (mswindows_popup_dialog_box):
* emacs.c:
* emacs.c (assert_failed):
* eval.c:
* eval.c (call_debugger):
* eval.c (signal_call_debugger):
* eval.c (Fcatch):
* eval.c (internal_catch):
* eval.c (unwind_to_catch):
* eval.c (throw_or_bomb_out):
* eval.c (condition_bind_unwind):
* eval.c (condition_case_1):
* eval.c (Fcall_with_condition_handler):
* eval.c (call_with_condition_handler):
* eval.c (signal_1):
* eval.c (check_catchlist_sanity):
* eval.c (call_with_suspended_errors):
* eval.c (Ffunction_min_args):
* eval.c (Ffunction_max_args):
* eval.c (struct call_trapping_problems):
* eval.c (flagged_a_squirmer):
* eval.c (call_trapping_problems_1):
* eval.c (call_trapping_problems):
* eval.c (calln_trapping_errors_1):
* eval.c (calln_trapping_errors):
* eval.c (call1_trapping_errors):
* eval.c (call2_trapping_errors):
* eval.c (call3_trapping_errors):
* eval.c (call4_trapping_errors):
* eval.c (call5_trapping_errors):
* eval.c (eval_in_buffer_trapping_errors_1):
* eval.c (eval_in_buffer_trapping_errors):
* eval.c (run_hook_trapping_errors_1):
* eval.c (safe_run_hook_trapping_errors):
* eval.c (grow_specpdl):
* eval.c (specbind):
* eval.c (specbind_magic):
* eval.c (record_unwind_protect):
* eval.c (unbind_to):
* eval.c (unbind_to_hairy):
* eval.c (vars_of_eval):
* event-Xt.c:
* event-Xt.c (emacs_Xt_select_process):
* event-Xt.c (emacs_Xt_unselect_process):
* event-Xt.c (emacs_Xt_create_io_streams):
* event-Xt.c (debug_process_finalization):
* event-Xt.c (reinit_vars_of_event_Xt):
* event-msw.c:
* event-msw.c (struct ntpipe_slurp_stream_shared_data):
* event-msw.c (struct ntpipe_shove_stream):
* event-msw.c (mswindows_enqueue_dispatch_event):
* event-msw.c (mswindows_dequeue_dispatch_event):
* event-msw.c (mswindows_cancel_dispatch_event):
* event-msw.c (add_waitable_handle):
* event-msw.c (remove_waitable_handle_1):
* event-msw.c (remove_waitable_handle):
* event-msw.c (struct mswindows_protect_modal_loop):
* event-msw.c (mswindows_protect_modal_loop):
* event-msw.c (mswindows_unmodalize_signal_maybe):
* event-msw.c (mswindows_pump_outstanding_events):
* event-msw.c (mswindows_drain_windows_queue):
* event-msw.c (mswindows_need_event):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_handle_paint):
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (mswindows_key_to_emacs_keysym):
* event-msw.c (get_process_stderr_waitable):
* event-msw.c (emacs_mswindows_select_process):
* event-msw.c (emacs_mswindows_unselect_process):
* event-msw.c (emacs_mswindows_create_io_streams):
* event-msw.c (emacs_mswindows_delete_io_streams):
* event-msw.c (debug_process_finalization):
* event-msw.c (reinit_vars_of_event_mswindows):
* event-msw.c (vars_of_event_mswindows):
* event-stream.c (event_stream_select_process):
* event-stream.c (event_stream_unselect_process):
* event-stream.c (event_stream_create_io_streams):
* event-stream.c (event_stream_deal_with_async_timeout):
* event-stream.c (run_pre_idle_hook):
* event-stream.c (Fnext_event):
* event-stream.c (Faccept_process_output):
* event-stream.c (Fsit_for):
* event-stream.c (execute_internal_event):
* event-stream.c (pre_command_hook):
* event-stream.c (post_command_hook):
* event-stream.c (vars_of_event_stream):
* event-tty.c (emacs_tty_select_process):
* event-tty.c (emacs_tty_unselect_process):
* event-tty.c (emacs_tty_select_console):
* event-tty.c (emacs_tty_create_io_streams):
* event-tty.c (emacs_tty_delete_io_streams):
* event-tty.c (reinit_vars_of_event_tty):
* event-unixoid.c (get_process_infd):
* event-unixoid.c (get_process_errfd):
* event-unixoid.c (event_stream_unixoid_select_process):
* event-unixoid.c (event_stream_unixoid_unselect_process):
* event-unixoid.c (event_stream_unixoid_create_io_streams):
* event-unixoid.c (event_stream_unixoid_delete_io_streams):
* events.h:
* events.h (struct event_stream):
* frame-msw.c (mswindows_size_frame_internal):
* frame.c (adjust_frame_size):
* gpmevent.c (get_process_infd):
* gpmevent.c (Fgpm_enable):
* lisp-disunion.h:
* lisp-union.h:
* lisp.h:
* lisp.h (struct Lisp_Subr):
* lisp.h (GCPRO1_ARRAY):
* lisp.h (NGCPRO1_ARRAY):
* lisp.h (NNGCPRO1_ARRAY):
* lisp.h (maybe_continuable_error_with_frob):
* macros.c (Fexecute_kbd_macro):
* menubar-msw.c (mswindows_translate_menu_or_dialog_item):
* menubar-msw.c (displayable_menu_item):
* menubar-msw.c (mswindows_char_is_accelerator):
* menubar-msw.c (mswindows_handle_wm_initmenupopup):
* menubar-msw.c (mswindows_handle_wm_initmenu):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c:
* nt.c (REG_ROOT):
* nt.c (msw_fstat):
* nt.c (msw_stat):
* nt.c (mswindows_sigset):
* nt.c (mswindows_sigrelse):
* nt.c (mswindows_sigpause):
* nt.c (mswindows_raise):
* nt.c (timer_proc):
* ntproc.c:
* ntproc.c (find_child_console):
* ntproc.c (sys_kill):
* print.c:
* print.c (std_handle_out_external):
* process-nt.c:
* process-nt.c (struct nt_process_data):
* process-nt.c (get_nt_process_handle_only_first_time):
* process-nt.c (find_child_console):
* process-nt.c (send_signal_the_95_way):
* process-nt.c (ensure_console_window_exists):
* process-nt.c (nt_create_process):
* process-unix.c:
* process-unix.c (struct unix_process_data):
* process-unix.c (close_process_descs_mapfun):
* process-unix.c (connect_to_file_descriptor):
* process-unix.c (unix_alloc_process_data):
* process-unix.c (unix_init_process_io_handles):
* process-unix.c (unix_create_process):
* process-unix.c (unix_set_window_size):
* process-unix.c (unix_deactivate_process):
* process-unix.c (unix_kill_child_process):
* process.c:
* process.c (mark_process):
* process.c (get_process_streams):
* process.c (get_process_from_usid):
* process.c (get_process_selected_p):
* process.c (set_process_selected_p):
* process.c (make_process_internal):
* process.c (init_process_io_handles):
* process.c (create_process):
* process.c (Fstart_process_internal):
* process.c (Fopen_network_stream_internal):
* process.c (Fopen_multicast_group_internal):
* process.c (read_process_output):
* process.c (Fset_process_stderr_buffer):
* process.c (Fprocess_stderr_mark):
* process.c (Fset_process_filter):
* process.c (Fset_process_stderr_filter):
* process.c (Fprocess_send_region):
* process.c (Fprocess_input_coding_system):
* process.c (Fprocess_output_coding_system):
* process.c (exec_sentinel):
* process.c (status_notify):
* process.c (Fprocess_send_eof):
* process.c (deactivate_process):
* process.c (syms_of_process):
* process.h:
* procimpl.h:
* procimpl.h (struct process_methods):
* procimpl.h (struct Lisp_Process):
* procimpl.h (DATA_ERRSTREAM):
* redisplay.c:
* redisplay.h:
* search.c (looking_at_1):
* search.c (string_match_1):
* search.c (search_buffer):
* search.c (Fstore_match_data):
* sysdep.c (sys_readlink):
* sysdep.c (sys_fstat):
* sysdep.c (sys_stat):
* syssignal.h:
* toolbar.c (update_toolbar_button):
* tooltalk.c (init_tooltalk):
* s/windowsnt.h:
* s/windowsnt.h (ENCAPSULATE_STAT):
* s/windowsnt.h (sigset):
--
Ben
In order to save my hands, I am cutting back on my mail. I also write
as succinctly as possible -- please don't be offended. If you send me
mail, you _will_ get a response, but please be patient, especially for
XEmacs-related mail. If you need an immediate response and it is not
apparent in your message, please say so. Thanks for your understanding.
See also
http://www.666.com/ben/typing.html.
ChangeLog:
@@ -1,3 1,7 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* etc/NEWS (MS-Windows):
lisp/ChangeLog:
@@ -1,3 1,22 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* lisp-mode.el:
* lisp-mode.el (lisp-interaction-mode-menubar-menu): New.
* lisp-mode.el (lisp-interaction-mode):
* process.el:
* process.el (call-process-internal): New.
* simple.el:
* simple.el (mark-ring):
* simple.el (dont-record-current-mark): New.
* simple.el (in-shifted-motion-command): New.
* simple.el (mark-ring-unrecorded-commands): New.
* simple.el (mark-ring-max):
* simple.el (set-mark-command):
* simple.el (push-mark):
* simple.el (handle-pre-motion-command):
* subr.el:
* subr.el (function-allows-args): New.
nt/ChangeLog:
@@ -1,3 1,8 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* README:
* xemacs.mak (TEMACS_DUMP_OBJS):
src/ChangeLog:
@@ -1,3 1,229 @@
2000-03-20 Ben Wing <ben(a)xemacs.org>
* alloc.c (garbage_collect_1):
* backtrace.h:
* backtrace.h (SPECBIND):
* backtrace.h (SPECBIND_FAST_UNSAFE):
* backtrace.h (UNBIND_TO_GCPRO):
* backtrace.h (UNBIND_TO):
* backtrace.h (UNBIND_TO_GCPRO_VARIABLES_ONLY):
* bytecode.c (execute_optimized_program):
* bytecode.c (execute_rare_opcode):
* callproc.c:
* callproc.c (syms_of_callproc):
* cmdloop.c (initial_command_loop):
* cmdloop.c (Frecursive_edit):
* cmdloop.c (call_command_loop):
* console-msw.c:
* console-msw.c (mswindows_get_console_hwnd):
* console-msw.c (mswindows_hide_console):
* console-msw.c (mswindows_show_console):
* console-msw.c (mswindows_ensure_console_buffered):
* console-msw.c (mswindows_windows9x_p):
* console-msw.h:
* device-msw.c (mswindows_get_workspace_coords):
* device-msw.c (mswindows_device_system_metrics):
* dialog-msw.c:
* dialog-msw.c (mswindows_is_dialog_msg):
* dialog-msw.c (dialog_proc):
* dialog-msw.c (mswindows_popup_dialog_box):
* emacs.c:
* emacs.c (assert_failed):
* eval.c:
* eval.c (call_debugger):
* eval.c (signal_call_debugger):
* eval.c (Fcatch):
* eval.c (internal_catch):
* eval.c (unwind_to_catch):
* eval.c (throw_or_bomb_out):
* eval.c (condition_bind_unwind):
* eval.c (condition_case_1):
* eval.c (Fcall_with_condition_handler):
* eval.c (call_with_condition_handler):
* eval.c (signal_1):
* eval.c (check_catchlist_sanity):
* eval.c (call_with_suspended_errors):
* eval.c (Ffunction_min_args):
* eval.c (Ffunction_max_args):
* eval.c (struct call_trapping_problems):
* eval.c (flagged_a_squirmer):
* eval.c (call_trapping_problems_1):
* eval.c (call_trapping_problems):
* eval.c (calln_trapping_errors_1):
* eval.c (calln_trapping_errors):
* eval.c (call1_trapping_errors):
* eval.c (call2_trapping_errors):
* eval.c (call3_trapping_errors):
* eval.c (call4_trapping_errors):
* eval.c (call5_trapping_errors):
* eval.c (eval_in_buffer_trapping_errors_1):
* eval.c (eval_in_buffer_trapping_errors):
* eval.c (run_hook_trapping_errors_1):
* eval.c (safe_run_hook_trapping_errors):
* eval.c (grow_specpdl):
* eval.c (specbind):
* eval.c (specbind_magic):
* eval.c (record_unwind_protect):
* eval.c (unbind_to):
* eval.c (unbind_to_hairy):
* eval.c (vars_of_eval):
* event-Xt.c:
* event-Xt.c (emacs_Xt_select_process):
* event-Xt.c (emacs_Xt_unselect_process):
* event-Xt.c (emacs_Xt_create_io_streams):
* event-Xt.c (debug_process_finalization):
* event-Xt.c (reinit_vars_of_event_Xt):
* event-msw.c:
* event-msw.c (struct ntpipe_slurp_stream_shared_data):
* event-msw.c (struct ntpipe_shove_stream):
* event-msw.c (mswindows_enqueue_dispatch_event):
* event-msw.c (mswindows_dequeue_dispatch_event):
* event-msw.c (mswindows_cancel_dispatch_event):
* event-msw.c (add_waitable_handle):
* event-msw.c (remove_waitable_handle_1):
* event-msw.c (remove_waitable_handle):
* event-msw.c (struct mswindows_protect_modal_loop):
* event-msw.c (mswindows_protect_modal_loop):
* event-msw.c (mswindows_unmodalize_signal_maybe):
* event-msw.c (mswindows_pump_outstanding_events):
* event-msw.c (mswindows_drain_windows_queue):
* event-msw.c (mswindows_need_event):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_handle_paint):
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (mswindows_key_to_emacs_keysym):
* event-msw.c (get_process_stderr_waitable):
* event-msw.c (emacs_mswindows_select_process):
* event-msw.c (emacs_mswindows_unselect_process):
* event-msw.c (emacs_mswindows_create_io_streams):
* event-msw.c (emacs_mswindows_delete_io_streams):
* event-msw.c (debug_process_finalization):
* event-msw.c (reinit_vars_of_event_mswindows):
* event-msw.c (vars_of_event_mswindows):
* event-stream.c (event_stream_select_process):
* event-stream.c (event_stream_unselect_process):
* event-stream.c (event_stream_create_io_streams):
* event-stream.c (event_stream_deal_with_async_timeout):
* event-stream.c (run_pre_idle_hook):
* event-stream.c (Fnext_event):
* event-stream.c (Faccept_process_output):
* event-stream.c (Fsit_for):
* event-stream.c (execute_internal_event):
* event-stream.c (pre_command_hook):
* event-stream.c (post_command_hook):
* event-stream.c (vars_of_event_stream):
* event-tty.c (emacs_tty_select_process):
* event-tty.c (emacs_tty_unselect_process):
* event-tty.c (emacs_tty_select_console):
* event-tty.c (emacs_tty_create_io_streams):
* event-tty.c (emacs_tty_delete_io_streams):
* event-tty.c (reinit_vars_of_event_tty):
* event-unixoid.c (get_process_infd):
* event-unixoid.c (get_process_errfd):
* event-unixoid.c (event_stream_unixoid_select_process):
* event-unixoid.c (event_stream_unixoid_unselect_process):
* event-unixoid.c (event_stream_unixoid_create_io_streams):
* event-unixoid.c (event_stream_unixoid_delete_io_streams):
* events.h:
* events.h (struct event_stream):
* frame-msw.c (mswindows_size_frame_internal):
* frame.c (adjust_frame_size):
* gpmevent.c (get_process_infd):
* gpmevent.c (Fgpm_enable):
* lisp-disunion.h:
* lisp-union.h:
* lisp.h:
* lisp.h (struct Lisp_Subr):
* lisp.h (GCPRO1_ARRAY):
* lisp.h (NGCPRO1_ARRAY):
* lisp.h (NNGCPRO1_ARRAY):
* lisp.h (maybe_continuable_error_with_frob):
* macros.c (Fexecute_kbd_macro):
* menubar-msw.c (mswindows_translate_menu_or_dialog_item):
* menubar-msw.c (displayable_menu_item):
* menubar-msw.c (mswindows_char_is_accelerator):
* menubar-msw.c (mswindows_handle_wm_initmenupopup):
* menubar-msw.c (mswindows_handle_wm_initmenu):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c:
* nt.c (REG_ROOT):
* nt.c (msw_fstat):
* nt.c (msw_stat):
* nt.c (mswindows_sigset):
* nt.c (mswindows_sigrelse):
* nt.c (mswindows_sigpause):
* nt.c (mswindows_raise):
* nt.c (timer_proc):
* ntproc.c:
* ntproc.c (find_child_console):
* ntproc.c (sys_kill):
* print.c:
* print.c (std_handle_out_external):
* process-nt.c:
* process-nt.c (struct nt_process_data):
* process-nt.c (get_nt_process_handle_only_first_time):
* process-nt.c (find_child_console):
* process-nt.c (send_signal_the_95_way):
* process-nt.c (ensure_console_window_exists):
* process-nt.c (nt_create_process):
* process-unix.c:
* process-unix.c (struct unix_process_data):
* process-unix.c (close_process_descs_mapfun):
* process-unix.c (connect_to_file_descriptor):
* process-unix.c (unix_alloc_process_data):
* process-unix.c (unix_init_process_io_handles):
* process-unix.c (unix_create_process):
* process-unix.c (unix_set_window_size):
* process-unix.c (unix_deactivate_process):
* process-unix.c (unix_kill_child_process):
* process.c:
* process.c (mark_process):
* process.c (get_process_streams):
* process.c (get_process_from_usid):
* process.c (get_process_selected_p):
* process.c (set_process_selected_p):
* process.c (make_process_internal):
* process.c (init_process_io_handles):
* process.c (create_process):
* process.c (Fstart_process_internal):
* process.c (Fopen_network_stream_internal):
* process.c (Fopen_multicast_group_internal):
* process.c (read_process_output):
* process.c (Fset_process_stderr_buffer):
* process.c (Fprocess_stderr_mark):
* process.c (Fset_process_filter):
* process.c (Fset_process_stderr_filter):
* process.c (Fprocess_send_region):
* process.c (Fprocess_input_coding_system):
* process.c (Fprocess_output_coding_system):
* process.c (exec_sentinel):
* process.c (status_notify):
* process.c (Fprocess_send_eof):
* process.c (deactivate_process):
* process.c (syms_of_process):
* process.h:
* procimpl.h:
* procimpl.h (struct process_methods):
* procimpl.h (struct Lisp_Process):
* procimpl.h (DATA_ERRSTREAM):
* redisplay.c:
* redisplay.h:
* search.c (looking_at_1):
* search.c (string_match_1):
* search.c (search_buffer):
* search.c (Fstore_match_data):
* sysdep.c (sys_readlink):
* sysdep.c (sys_fstat):
* sysdep.c (sys_stat):
* syssignal.h:
* toolbar.c (update_toolbar_button):
* tooltalk.c (init_tooltalk):
* s/windowsnt.h:
* s/windowsnt.h (ENCAPSULATE_STAT):
* s/windowsnt.h (sigset):
Index: etc/NEWS
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/etc/NEWS,v
retrieving revision 1.58.2.39
diff -u -w -r1.58.2.39 NEWS
--- NEWS 2000/03/19 14:14:31 1.58.2.39
+++ NEWS 2000/03/20 12:16:04
@@ -222,7 +222,7 @@
If both `.emacs' and `.emacs.el' exist, the latter file is the one
that is used.
-** New variable `mswindows-meta-activates-menu'.
+** New variable `mswindows-alt-by-itself-activates-menu'.
If you set this variable to nil then pressing and releasing the Alt
key under MS-Windows will no longer activate the menubar. The default
is t. This is not to be confused with `menu-accelerator-enabled',
Index: lisp/process.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/process.el,v
retrieving revision 1.5.2.6
diff -u -w -r1.5.2.6 process.el
--- process.el 2000/01/26 05:28:39 1.5.2.6
+++ process.el 2000/03/20 12:16:05
@@ -1,7 +1,7 @@
;;; process.el --- commands for subprocesses; split out of simple.el
;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Ben Wing.
+;; Copyright (C) 1995, 2000 Ben Wing.
;; Author: Ben Wing
;; Maintainer: XEmacs Development Team
@@ -66,6 +66,103 @@
;; but that failed to handle (...) and semicolon, etc.
(start-process name buffer shell-file-name shell-command-switch
(mapconcat #'identity args " ")))
+
+(defun call-process-internal (program &optional infile buffer display &rest
args)
+ "Call PROGRAM synchronously in separate process, with coding-system specified.
+Arguments are
+ (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
+The program's input comes from file INFILE (nil means `/dev/null').
+Insert output in BUFFER before point; t means current buffer;
+ nil for BUFFER means discard it; 0 means discard and don't wait.
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+
+If BUFFER is 0, `call-process' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
+ or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you
+ quit again."
+ ;; #### remove windows-nt check when this is ready for prime time.
+ (if (or (noninteractive) (not (eq 'windows-nt system-type)))
+ (apply 'old-call-process-internal program infile buffer display args)
+ (let (proc inbuf errbuf discard)
+ (unwind-protect
+ (progn
+ (when infile
+ (setq infile (expand-file-name infile))
+ (setq inbuf (generate-new-buffer "*call-process*"))
+ (with-current-buffer inbuf
+ (insert-file-contents-internal infile nil nil nil nil
+ coding-system-for-read)))
+ (let ((stderr (if (consp buffer) (second buffer) t))
+ (buf (cond ((consp buffer) (get-buffer-create (car buffer)))
+ ((eq buffer t) (current-buffer))
+ ;; use integerp for compatibility with existing
+ ;; call-process rmsism.
+ ((integerp buffer) (setq discard t) nil)
+ (t (get-buffer-create buffer)))))
+ (when (and stderr (not (eq t stderr)))
+ (setq stderr (expand-file-name stderr))
+ (setq errbuf (generate-new-buffer "*call-process*")))
+ (setq proc
+ (apply 'start-process-internal "*call-process*"
+ (if (eq t stderr) buf (list buf errbuf))
+ program args))
+ (if buf
+ (set-marker (process-mark proc) (point buf) buf))
+ (unwind-protect
+ (progn
+ (catch 'call-process-done
+ (when (not discard)
+ (set-process-sentinel
+ proc
+ #'(lambda (proc status)
+ (cond ((eq 'exit (process-status proc))
+ (set-process-sentinel proc nil)
+ (throw 'call-process-done
+ (process-exit-status proc)))
+ ((eq 'signal (process-status proc))
+ (set-process-sentinel proc nil)
+ (throw 'call-process-done status))))))
+ (when inbuf
+ (process-send-region proc 1
+ (1+ (buffer-size inbuf)) inbuf))
+ (process-send-eof proc)
+ (when discard
+ ;; we're trying really really hard to emulate
+ ;; the old call-process.
+ (if errbuf
+ (set-process-sentinel
+ proc
+ `(lambda (proc status)
+ (write-region-internal
+ 1 (1+ (buffer-size))
+ ,stderr
+ nil 'major-rms-kludge-city nil
+ coding-system-for-write))))
+ (setq errbuf nil)
+ (setq proc nil)
+ (throw 'call-process-done nil))
+ (while t
+ (accept-process-output proc)
+ (if display (sit-for 0))))
+ (when errbuf
+ (with-current-buffer errbuf
+ (write-region-internal 1 (1+ (buffer-size)) stderr
+ nil 'major-rms-kludge-city nil
+ coding-system-for-write))))
+ (if proc (set-process-sentinel proc nil)))))
+ (if inbuf (kill-buffer inbuf))
+ (if errbuf (kill-buffer errbuf))
+ (condition-case nil
+ (if (and proc (process-live-p proc)) (kill-process proc))
+ (error nil))))))
(defun call-process (program &optional infile buffer displayp &rest args)
"Call PROGRAM synchronously in separate process.
Index: lisp/lisp-mode.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/lisp-mode.el,v
retrieving revision 1.10.2.3
diff -u -w -r1.10.2.3 lisp-mode.el
--- lisp-mode.el 2000/03/13 07:27:41 1.10.2.3
+++ lisp-mode.el 2000/03/20 12:16:06
@@ -90,8 +90,9 @@
;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the
;*scratch* buffer has a Lisp menubar item! Very confusing.
-;(defvar lisp-interaction-mode-menubar-menu
-; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu))))
+;Jan Vroonhof really wants this, so it's back. --ben
+(defvar lisp-interaction-mode-menubar-menu
+ (purecopy (cons "%_Lisp" (cdr lisp-interaction-mode-popup-menu))))
(defvar emacs-lisp-mode-menubar-menu
(purecopy (cons "%_Lisp" (cdr emacs-lisp-mode-popup-menu))))
@@ -363,7 +364,13 @@
(setq major-mode 'lisp-interaction-mode)
(setq mode-name "Lisp Interaction")
(setq mode-popup-menu lisp-interaction-mode-popup-menu)
-
+ (if (and (featurep 'menubar)
+ current-menubar)
+ (progn
+ ;; make a local copy of the menubar, so our modes don't
+ ;; change the global menubar
+ (set-buffer-menubar current-menubar)
+ (add-submenu nil lisp-interaction-mode-menubar-menu)))
(set-syntax-table emacs-lisp-mode-syntax-table)
(lisp-mode-variables nil)
(run-hooks 'lisp-interaction-mode-hook))
Index: lisp/simple.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/simple.el,v
retrieving revision 1.24.2.10
diff -u -w -r1.24.2.10 simple.el
--- simple.el 2000/03/13 07:27:44 1.24.2.10
+++ simple.el 2000/03/20 12:16:08
@@ -1667,10 +1667,71 @@
; (set-marker (mark-marker) nil)))
(defvar mark-ring nil
- "The list of former marks of the current buffer, most recent first.")
+ "The list of former marks of the current buffer, most recent first.
+This variable is automatically buffer-local.")
(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
+(defvar dont-record-current-mark nil
+ "If set to t, the current mark value should not be recorded on the mark ring.
+This is set by commands that manipulate the mark incidentally, to avoid
+cluttering the mark ring unnecessarily. Under most circumstances, you do
+not need to set this directly; it is automatically reset each time
+`push-mark' is called, according to `mark-ring-unrecorded-commands'. This
+variable is automatically buffer-local.")
+(make-variable-buffer-local 'dont-record-current-mark)
+(put 'dont-record-current-mark 'permanent-local t)
+
+;; a conspiracy between push-mark and handle-pre-motion-command
+(defvar in-shifted-motion-command nil)
+
+(defcustom mark-ring-unrecorded-commands '(shifted-motion-commands
+ yank
+ mark-beginning-of-buffer
+ mark-bob
+ mark-defun
+ mark-end-of-buffer
+ mark-end-of-line
+ mark-end-of-sentence
+ mark-eob
+ mark-marker
+ mark-page
+ mark-paragraph
+ mark-sexp
+ mark-whole-buffer
+ mark-word)
+ "*List of commands whose marks should not be recorded on the mark stack.
+Many commands set the mark as part of their action. Normally, all such
+marks get recorded onto the mark stack. However, this tends to clutter up
+the mark stack unnecessarily. You can control this by putting a command
+onto this list. Then, any marks set by the function will not be recorded.
+
+The special value `shifted-motion-commands' causes marks set as a result
+of selection using any shifted motion commands to not be recorded.
+
+The value `yank' affects all yank-like commands, as well as just `yank'."
+ :type '(repeat (choice (const :tag "shifted motion commands"
+ 'shifted-motion-commands)
+ (const :tag "functions that select text"
+ :inline t
+ '(mark-beginning-of-buffer
+ mark-bob
+ mark-defun
+ mark-end-of-buffer
+ mark-end-of-line
+ mark-end-of-sentence
+ mark-eob
+ mark-marker
+ mark-page
+ mark-paragraph
+ mark-sexp
+ mark-whole-buffer
+ mark-word))
+ (const :tag "functions that paste text"
+ 'yank)
+ function))
+ :group 'killing)
+
(defcustom mark-ring-max 16
"*Maximum size of mark ring. Start discarding off end if gets this big."
:type 'integer
@@ -1692,6 +1753,14 @@
With argument, jump to mark, and pop a new position for mark off the ring
\(does not affect global mark ring\).
+The mark ring is a per-buffer stack of marks, most recent first. Its
+maximum length is controlled by `mark-ring-max'. Generally, when new
+marks are set, the current mark is pushed onto the stack. You can pop
+marks off the stack using \\[universal-argument] \\[set-mark-command]. The term
\"ring\" is used because when
+you pop a mark off the stack, the current mark value is pushed onto the
+far end of the stack. If this is confusing, just think of the mark ring
+as a stack.
+
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
@@ -1699,6 +1768,7 @@
(push-mark nil nil t)
(if (null (mark t))
(error "No mark set in this buffer")
+ (if dont-record-current-mark (pop-mark))
(goto-char (mark t))
(pop-mark))))
@@ -1713,7 +1783,7 @@
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(setq buffer (decode-buffer buffer)) ; XEmacs
- (if (null (mark t buffer)) ; XEmacs
+ (if (or dont-record-current-mark (null (mark t buffer))) ; XEmacs
nil
;; The save-excursion / set-buffer is necessary because mark-ring
;; is a buffer local variable
@@ -1727,8 +1797,9 @@
(set-mark (or location (point buffer)) buffer)
; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF
;; Now push the mark on the global mark ring.
- (if (or (null global-mark-ring)
- (not (eq (marker-buffer (car global-mark-ring)) buffer)))
+ (if (and (not dont-record-current-mark)
+ (or (null global-mark-ring)
+ (not (eq (marker-buffer (car global-mark-ring)) buffer))))
;; The last global mark pushed wasn't in this same buffer.
(progn
(setq global-mark-ring (cons (copy-marker (mark-marker t buffer))
@@ -1738,7 +1809,13 @@
(move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
nil buffer)
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))))
- (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
+ (setq dont-record-current-mark
+ (not (not (or (and in-shifted-motion-command
+ (memq 'shifted-motion-commands
+ mark-ring-unrecorded-commands))
+ (memq this-command mark-ring-unrecorded-commands)))))
+ (or dont-record-current-mark nomsg executing-kbd-macro
+ (> (minibuffer-depth) 0)
(display-message 'command "Mark set"))
(if activate-region
(progn
@@ -1877,7 +1954,8 @@
shifted-motion-keys-select-region
(not (region-active-p))
(memq 'shift (event-modifiers last-input-event)))
- (push-mark nil nil t)))
+ (let ((in-shifted-motion-command t))
+ (push-mark nil nil t))))
(defun handle-post-motion-command ()
(if
Index: lisp/subr.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/subr.el,v
retrieving revision 1.8.2.13
diff -u -w -r1.8.2.13 subr.el
--- subr.el 2000/03/13 07:27:44 1.8.2.13
+++ subr.el 2000/03/20 12:16:08
@@ -728,6 +728,12 @@
(t
(error "Non-funcallable object: %s" function))))
+(defun function-allows-args (function n)
+ "Return whether FUNCTION can be called with N arguments."
+ (and (<= (function-min-args function) n)
+ (or (null (function-max-args function))
+ (<= n (function-max-args function)))))
+
;; This function used to be an alias to `buffer-substring', except
;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way.
;; The new FSF's semantics makes more sense, but we try to support
Index: nt/README
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/nt/README,v
retrieving revision 1.8.2.6
diff -u -w -r1.8.2.6 README
--- README 2000/02/21 02:28:10 1.8.2.6
+++ README 2000/03/20 12:16:10
@@ -1,12 +1,12 @@
-Building and Installing XEmacs on Windows NT -*- mode:outline -*-
+Building and Installing XEmacs on Windows 95/98/NT -*- mode:outline -*-
David Hobley
Marc Paquette
Jonathan Harris
+ Ben Wing
-The port was made much easier by the groundbreaking work of Geoff Voelker
-and others who worked on the GNU Emacs port to NT. Their version is available
-from
http://www.cs.washington.edu/homes/voelker/ntemacs.html
+This is a port of XEmacs to Windows 95/98/NT. If you are looking for a port
+of GNU Emacs, see
http://www.cs.washington.edu/homes/voelker/ntemacs.html.
* Required tools and sources
@@ -26,14 +26,20 @@
2. Grab the latest XEmacs source from
ftp.xemacs.org if necessary.
- You'll also need the xemacs-base package from the binary-packages
- subdirectory and you'll probably also want at least the edit-utils,
- text-modes, fsf-compat, cc-mode, prog-modes and xemacs-devel
- packages.
+ You'll also need the packages. You probably want to get the unified
+ packages bundle from
- You'll also need the texinfo package unless you have a copy of
- makeinfo.exe on your machine.
+
ftp://ftp.xemacs.org/pub/xemacs/packages/xemacs-sumo.tar.gz
+ Although we don't recommend it, you can also retrieve just the packages
+ you really need if you have an extremely slow net connection or are very
+ short on disk space. You can find the various packages in
+
ftp://ftp.xemacs.org/pub/xemacs/packages/. You'll need the xemacs-base
+ package and you'll probably also want at least the edit-utils, text-modes,
+ fsf-compat, cc-mode, prog-modes and xemacs-devel packages. You'll also
+ need the texinfo package unless you have a copy of makeinfo.exe on your
+ machine.
+
Unpack the packages into, say, "c:\Program Files\XEmacs\xemacs-packages".
3. At this point you can choose to build for X and/or for Win32 native GUI.
@@ -45,8 +51,8 @@
If you want support for X you will also need:
-1. An X server. MI/X is available on the Internet for free; It is
- available from:
http://www.microimages.com/www/html/freestuf/mixdlfrm.htm
+1. An X server. MI/X is available on the Internet as trialware; it is
+ available from:
http://www.microimages.com/www/html/mix/
2. Source for the MIT X11R6.3 libraries, available from:
ftp.x.org
@@ -64,15 +70,17 @@
* Optional libraries
====================
-1. If you want XPM image and toolbar support grab the latest version of the
- xpm sources (xpm-3.4k.tar.gz at time of writing) and unpack them somewhere.
+1. You really want the XPM library. Grab the latest version of the
+ xpm sources (xpm-3.4k.tar.gz at time of writing) from
+
ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack them somewhere.
Copy nt\xpm.mak from the xemacs sources to the lib subdirectory of the
xpm sources, cd to that directory and build xpm with 'nmake -f xpm.mak'.
2. You probably also want PNG image support. Grab the latest versions of zlib
- and libpng (zlib-1.1.3 and libpng-1.0.2 at time of writing), unpack them
- somewhere and read the respective READMEs for details on how to build them.
- The following build procedure works for zlib-1.1.3 and libpng-1.0.2:
+ and libpng (zlib-1.1.3 and libpng-1.0.2 at time of writing) from
+
ftp://ftp.xemacs.org/pub/xemacs/aux/, unpack them somewhere and read
+ the respective READMEs for details on how to build them. The following
+ build procedure works for zlib-1.1.3 and libpng-1.0.2:
cd to the zlib directory, type 'copy msdos\makefile.w32 Makefile' and
then type 'nmake'.
@@ -81,106 +89,156 @@
and type 'nmake -f scripts\makefile.w32'.
3. If you want TIFF support, grap the latest version of libtiff (tiff-v3.4
- at time of writing) and unpack it somewhere. Copy nt\tiff.mak from the
- xemacs sources to the contrib\winnt subdirectory of the tiff sources,
- cd to that directory and build libtiff with 'nmake -f tiff.mak'. Note:
- tiff.mak has only been verified to work under WinNT, not Win95 or 98.
- However, the lastest distribution of libtiff includes a
- contrib\win95\makefile.w95; that might work.
+ at time of writing) from
ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack
+ it somewhere. Copy nt\tiff.mak from the xemacs sources to the
+ contrib\winnt subdirectory of the tiff sources, cd to that directory and
+ build libtiff with 'nmake -f tiff.mak'. Note: tiff.mak has only been
+ verified to work under WinNT, not Win95 or 98. However, the lastest
+ distribution of libtiff includes a contrib\win95\makefile.w95; that might
+ work.
4. If you want JPEG support grab the latest version of jpegsrc (jpeg-6b at
- time of writing) and read the README for details on how to build it.
+ time of writing) from
ftp://ftp.xemacs.org/pub/xemacs/aux/ and read the
+ README for details on how to build it.
-5. If you want X-Face support, grab compface distribution and unpack it
- somewhere. Copy nt\compface.mak from xemacs sources to the compface
- directory. cd to that directory and build libcompface with
- 'nmake -f compface.mak'.
+5. If you want X-Face support, grab the compface distribution from
+
ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack it somewhere.
+ Copy nt\compface.mak from xemacs sources to the compface directory.
+ cd to that directory and build libcompface with 'nmake -f compface.mak'.
* Building
==========
+
+1. cd to the nt subdirectory of the xemacs distribution and copy the file
+ config.inc.samp to config.inc. Make any necessary modifications. This
+ file controls the options that XEmacs is built with:
-1. cd to the nt subdirectory of the xemacs distribution and build xemacs:
- `nmake install -f xemacs.mak`, but read on before hitting Enter.
+ -- If you're building with XPM support, modify the appropriate lines in
+ config.inc as follows:
-2. If you're building with XPM support, add this to the nmake command line:
- HAVE_XPM=1 XPM_DIR="x:\location\of\your\xpm\sources"
+ HAVE_XPM=1
+ XPM_DIR="x:\location\of\your\xpm\sources"
+
and similarly for JPEG and TIFF support.
+
+ -- If you're building with PNG support, modify the appropriate lines in
+ config.inc as follows:
- If you're building with PNG support, add this to the nmake command line:
- HAVE_PNG=1 PNG_DIR="x:\location\of\your\png\sources"
+ HAVE_PNG=1
+ PNG_DIR="x:\location\of\your\png\sources"
ZLIB_DIR="x:\location\of\your\zlib\sources"
- If you want to build with GIF support, add this to the nmake command line:
+ -- If you're building with GIF support, modify the appropriate lines in
+ config.inc as follows:
+
HAVE_GIF=1
+
+ -- If you're building with X-Face support, modify the appropriate lines in
+ config.inc as follows:
+
+ HAVE_XFACE=1
+ COMPFACE_DIR="x:\location\of\your\compface\sources"
- If you're building with X-Face support, add this to the nmake command line:
- HAVE_XFACE=1 COMPFACE_DIR="x:\location\of\your\compface\sources"
+ -- If you're building for X, modify the appropriate lines in config.inc
+ as follows:
- If you're building for X, add this to the nmake command line:
- HAVE_X=1 X11_DIR=x:\root\directory\of\your\X11\installation
+ HAVE_X=1
+ X11_DIR=x:\root\directory\of\your\X11\installation
+
+ -- By default, XEmacs will expect to find its packages in the
+ subdirectories "site-packages", "mule-packages" and
"xemacs-packages"
+ under the package prefix directory "c:\Program Files\XEmacs". If you
+ want it to look for these subdirectories elsewhere, modify the
+ appropriate lines in config.inc as follows:
-3. By default, XEmacs will expect to find its packages in the subdirectories
- "site-packages", "mule-packages" and "xemacs-packages"
under the package
- prefix directory "c:\Program Files\XEmacs". If you want it to look for
- these subdirectories elsewhere, add this to the nmake command line:
PACKAGE_PREFIX="x:\your\package\directory"
+
If you change your mind and want to alter the package prefix directory
after you've built XEmacs, delete the file nt\obj\emacs.obj and rebuild
with the new PACKAGE_PREFIX setting.
-4. By default, XEmacs will be installed in directories under the directory
- "c:\Program Files\XEmacs\XEmacs-21.2". If you want to install it
- elsewhere, add this to the nmake command line:
- INSTALL_DIR="x:\your\installation\directory"
+ -- XEmacs can build its info files more quickly if you have a copy of the
+ makeinfo program. If you have a copy, modify the appropriate lines in
+ config.inc as follows:
-5. XEmacs can build its info files more quickly if you have a copy of the
- makeinfo program. If you have a copy, add this to the nmake command line:
MAKEINFO="x:\location\of\makeinfo.exe"
+
If you don't have a copy of makeinfo then you'll need to have installed
the XEmacs texinfo package.
+
+2. If you want to install XEmacs when you build it, modify the appropriate
+ lines in config.inc as follows (you can also run XEmacs from its build
+ directory):
+
+ INSTALL_DIR="x:\your\installation\directory"
-6. Now you can press Enter. nmake will build temacs, the DOC file, update
- the elc's, dump xemacs and install the relevant files in the directories
- under the installation directory.
-
- Unless you set INSTALL_DIR above, the file that you should run to start
- XEmacs will be installed as
- "c:\Program Files\XEmacs\XEmacs-21.2\i586-pc-win32\runxemacs.exe".
- You may want to create a shortcut to that file from your Desktop or
+ (By default, XEmacs will be installed in directories under the directory
+ "c:\Program Files\XEmacs\XEmacs-21.2".)
+
+2. If you want to build xemacs on the command line, use
+ `nmake install -f xemacs.mak', or just `nmake -f xemacs.mak' if you want
+ to run XEmacs from its build directory. nmake will build temacs, the DOC
+ file, update the elc's, dump xemacs and (optionally) install the relevant
+ files in the directories under the installation directory.
+
+ If you chose to install XEmacs, the file that you should run to start
+ XEmacs will be installed (by default) as
+ "c:\Program Files\XEmacs\XEmacs-21.2\i586-pc-win32\xemacs.exe".
+
+ To run from the build directory, run the file "nt\xemacs.exe" off of the
+ root of the build directory.
+
+ You may want to create a shortcut to the file from your Desktop or
Start Menu.
+3. To build using MS Developer Studio, you can use the workshop file
+ `nt/xemacs.dsw'. This was prepared for Visual C++ 5.0; if you have
+ a different version and this file doesn't work, just open up
+ `nt/xemacs.mak' from within MS Developer Studio and it will offer to
+ wrap this Makefile in a workshop file, from which you can build.
+ Assuming you want to run from the build directory (which you will
+ want to do if you are planning on doing any development work on XEmacs),
+ use the following settings in Project/Settings...:
+
+ Under the General tab:
+
+ Build command line: NMAKE /f xemacs.mak
+ Output file name: ..\src\xemacs.exe
+ Browse info file name: ..\src\temacs.bsc
+
+ Under the Debug tab:
+
+ Executable from debug session: ..\src\xemacs.exe
+
+ If you want to install XEmacs when it's built, change the build command
+ line to "NMAKE install /f xemacs.mak". (You will have to make the same
+ change even if you use the provided workspace nt/xemacs.dsw.)
+
+
* Debugging under MS Developer Studio
=====================================
The build process always creates debugging and "Source Browser" information
in the source tree for use with DevStudio. If you actually want to debug
XEmacs you should probably build a debug version of XEmacs:
+
+1. If you already built XEmacs, delete the directory nt\obj and its contents.
+
+2. Add DEBUG_XEMACS=1 to config.inc.
+
+3. See instructions above for obtaining a workspace file for use with
+ MS Developer Studio. Build and debug your XEmacs this way.
-1. Delete the directory nt\obj and it's contents.
+4. To display the contents of a lisp variable, type Shift-F9 (or use the
+ menu) to bring up the QuickWatch window, type debug_print(variable) and
+ click Recalculate. The output will appear in a console window, as well
+ as in the Debug window in MS Developer Studio.
-2. Add DEBUG_XEMACS=1 to the nmake command line and rebuild. You probably
- don't want to install your debug build so you should tell nmake to build
- the 'all' target instead of the 'install' target.
-
-3. To make use of the debugging and "Source Browser" information, create a
- new "console" project in DevStudio and, under Project/Settings, set:
- Debug: executable name = full path of src\xemacs.exe
- Link: output file name = full path of src\temacs.exe
- Browse Info: browse info file name = full path of src\temacs.bsc
- Remember to close the Source Browser file in DevStudio before rebuilding.
-
-4. Start XEmacs from within DevStudio or by running src\xemacs.exe so that
- you get a console window which may contain helpful debugging info.
-
-5. To display the contents of a lisp variable click Debug/QuickWatch, type
- debug_print(variable) and click Recalculate. The output will appear in
- the console window.
-
-6. To view lisp variables in the "Watch" window wrap the variable in one of
- the helper functions from the file src\console-msw.c. eg type
- DSTRING(variable) in the "Watch" window to inspect a lisp string.
+5. To view Lisp variables in the "Watch" window wrap the variable in one of
+ the helper functions from the file src\console-msw.c, for example type
+ DSTRING(variable) in the "Watch" window to inspect a Lisp string.
* Known Problems
@@ -199,5 +257,6 @@
Marc Paquette
August Hill
Jonathan Harris
+Ben Wing
and others.
Index: nt/xemacs.mak
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/nt/xemacs.mak,v
retrieving revision 1.41.2.47
diff -u -w -r1.41.2.47 xemacs.mak
--- xemacs.mak 2000/03/15 20:36:10 1.41.2.47
+++ xemacs.mak 2000/03/20 12:16:10
@@ -865,6 +865,9 @@
!if !$(USE_PORTABLE_DUMPER)
TEMACS_DUMP_OBJS=\
$(OUTDIR)\unexnt.obj
+!else
+TEMACS_DUMP_OBJS=\
+ $(OUTDIR)\dumper.obj
!endif
TEMACS_OBJS= \
Index: src/backtrace.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/backtrace.h,v
retrieving revision 1.2.2.5
diff -u -w -r1.2.2.5 backtrace.h
--- backtrace.h 2000/02/07 07:59:41 1.2.2.5
+++ backtrace.h 2000/03/20 12:16:12
@@ -35,6 +35,18 @@
#include <setjmp.h>
+#ifdef ERROR_CHECK_CATCH
+/* you can use this if you are trying to debug corruption in the
+ catchlist */
+void check_catchlist_sanity (void);
+
+/* you can use this if you are trying to debug corruption in the specbind stack */
+void check_specbind_stack_sanity (void);
+#else
+#define check_catchlist_sanity()
+#define check_specbind_stack_sanity()
+#endif
+
/* These definitions are used in eval.c and alloc.c */
struct backtrace
@@ -54,18 +66,24 @@
/* This structure helps implement the `catch' and `throw' control
structure. A struct catchtag contains all the information needed
to restore the state of the interpreter after a non-local jump.
-
- Handlers for error conditions (represented by `struct handler'
- structures) just point to a catch tag to do the cleanup required
- for their jumps.
+ (No information is stored concerning how to restore the state of
+ the condition-handler list; this is handled implicitly through
+ an unwind-protect. unwind-protects are on the specbind stack,
+ which is reset to its proper value by `throw'. In the process of
+ that, any intervening bindings are reset and unwind-protects called,
+ which fixes up the condition-handler list.
catchtag structures are chained together in the C calling stack;
the `next' member points to the next outer catchtag.
A call like (throw TAG VAL) searches for a catchtag whose `tag'
- member is TAG, and then unbinds to it. The `val' member is used to
- hold VAL while the stack is unwound; `val' is returned as the value
- of the catch form.
+ member is TAG, and then unbinds to it. A value of Vcatch_everything_tag
+ for the `tag' member of a catchtag is special and means "catch all throws,
+ regardless of the tag". This is used internally by the C code. The `val'
+ member is used to hold VAL while the stack is unwound; `val' is returned
+ as the value of the catch form. The `actual_tag' member holds the value
+ of TAG as passed to throw, so that it can be retrieved when catches with
+ Vcatch_everything_tag are set up.
All the other members are concerned with restoring the interpreter
state. */
@@ -73,13 +91,22 @@
struct catchtag
{
Lisp_Object tag;
+ /* Stores the actual tag used in `throw'; the same as TAG, unless
+ TAG is Vcatch_everything_tag. */
+ Lisp_Object actual_tag;
Lisp_Object val;
struct catchtag *next;
struct gcpro *gcpro;
JMP_BUF jmp;
struct backtrace *backlist;
#if 0 /* FSFmacs */
- /* #### */
+ /* FSF maintains their condition-handler list as a list chained
+ through the stack frames of the condition-case functions.
+ The correct position of that list is remembered here, so it can
+ be reset.
+
+ We maintain our condition-handler list as a standard list, and
+ use unwind-protects to restore the list to its appropriate state. */
struct handler *handlerlist;
#endif
int lisp_eval_depth;
@@ -187,6 +214,7 @@
} \
else \
specbind_magic (SB_symbol, SB_newval); \
+ check_specbind_stack_sanity (); \
} while (0)
/* An even faster, but less safe inline version of specbind().
@@ -211,6 +239,7 @@
} \
else \
specbind_magic (SFU_symbol, SFU_newval); \
+ check_specbind_stack_sanity (); \
} while (0)
/* Request enough room for SIZE future entries on special binding stack */
@@ -247,6 +276,7 @@
\
sym->value = specpdl_ptr->old_value; \
} \
+ check_specbind_stack_sanity (); \
} while (0)
/* A slightly faster inline version of unbind_to,
@@ -269,14 +299,9 @@
\
sym->value = specpdl_ptr->old_value; \
} \
+ check_specbind_stack_sanity (); \
} while (0)
-#ifdef ERROR_CHECK_TYPECHECK
-#define CHECK_SPECBIND_VARIABLE assert (specpdl_ptr->func == 0)
-#else
-#define CHECK_SPECBIND_VARIABLE DO_NOTHING
-#endif
-
#if 0
/* Unused. It's too hard to guarantee that the current bindings
contain only variables. */
@@ -292,7 +317,6 @@
--specpdl_ptr; \
--specpdl_depth_counter; \
\
- CHECK_SPECBIND_VARIABLE; \
sym = XSYMBOL (specpdl_ptr->symbol); \
if (!SYMBOL_VALUE_MAGIC_P (sym->value)) \
sym->value = specpdl_ptr->old_value; \
Index: src/bytecode.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/bytecode.c,v
retrieving revision 1.13.2.18
diff -u -w -r1.13.2.18 bytecode.c
--- bytecode.c 2000/02/21 23:06:53 1.13.2.18
+++ bytecode.c 2000/03/20 12:16:12
@@ -719,6 +719,10 @@
specpdl_depth_counter++;
symbol_ptr->value = new_value;
+
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
else
specbind_magic (symbol, new_value);
@@ -1250,7 +1254,7 @@
case Bcatch:
{
Lisp_Object arg = POP;
- TOP = internal_catch (TOP, Feval, arg, 0);
+ TOP = internal_catch (TOP, Feval, arg, 0, 0);
break;
}
Index: src/cmdloop.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/cmdloop.c,v
retrieving revision 1.9.2.3
diff -u -w -r1.9.2.3 cmdloop.c
--- cmdloop.c 1999/12/23 02:50:42 1.9.2.3
+++ cmdloop.c 2000/03/20 12:16:12
@@ -278,7 +278,7 @@
Otherwise, this function will return normally when all command-
line arguments have been processed, the user's initialization
file has been read in, and the first frame has been created. */
- internal_catch (Qtop_level, top_level_1, Qnil, 0);
+ internal_catch (Qtop_level, top_level_1, Qnil, 0, 0);
/* If an error occurred during startup and the initial console
wasn't created, then die now (the error was already printed out
@@ -298,7 +298,7 @@
MARK_MODELINE_CHANGED;
/* Now invoke the command loop. It never returns; however, a
throw to 'top-level will place us at the end of this loop. */
- internal_catch (Qtop_level, command_loop_2, Qnil, 0);
+ internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0);
/* #### wrong with selected-console? */
/* We don't actually call clear_echo_area() here, partially
at least because that runs Lisp code and it may be unsafe
@@ -361,7 +361,7 @@
specbind (Qstandard_output, Qt);
specbind (Qstandard_input, Qt);
- val = internal_catch (Qexit, command_loop_2, Qnil, 0);
+ val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0);
if (EQ (val, Qt))
/* Turn abort-recursive-edit into a quit. */
@@ -429,7 +429,7 @@
Fcommand_loop_1 ();
else
internal_catch (Qtop_level,
- cold_load_command_loop, Qnil, 0);
+ cold_load_command_loop, Qnil, 0, 0);
goto loop;
return Qnil;
}
Index: src/lisp-disunion.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp-disunion.h,v
retrieving revision 1.9.2.5
diff -u -w -r1.9.2.5 lisp-disunion.h
--- lisp-disunion.h 2000/02/16 02:06:40 1.9.2.5
+++ lisp-disunion.h 2000/03/20 12:16:12
@@ -98,6 +98,13 @@
#define XSETCHAR(var, value) ((void) ((var) = make_char (value)))
#define XSETOBJ(var, vartype, value) ((void) ((var) = make_obj (vartype, value)))
+/* WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ You can only VOID_TO_LISP something that had previously been
+ LISP_TO_VOID'd. You cannot go the other way, i.e. create a bogus
+ Lisp_Object. If you want to stuff a void * into a Lisp_Object, use
+ make_opaque_ptr(). */
+
/* Convert between a (void *) and a Lisp_Object, as when the
Lisp_Object is passed to a toolkit callback function */
#define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg))))
Index: src/lisp-union.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp-union.h,v
retrieving revision 1.8.2.6
diff -u -w -r1.8.2.6 lisp-union.h
--- lisp-union.h 2000/02/26 11:39:48 1.8.2.6
+++ lisp-union.h 2000/03/20 12:16:12
@@ -131,6 +131,13 @@
#define INT_PLUS1(x) make_int (XINT (x) + 1)
#define INT_MINUS1(x) make_int (XINT (x) - 1)
+/* WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ You can only VOID_TO_LISP something that had previously been
+ LISP_TO_VOID'd. You cannot go the other way, i.e. create a bogus
+ Lisp_Object. If you want to stuff a void * into a Lisp_Object, use
+ make_opaque_ptr(). */
+
/* Convert between a (void *) and a Lisp_Object, as when the
Lisp_Object is passed to a toolkit callback function */
#define VOID_TO_LISP(larg,varg) \
Index: src/macros.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/macros.c,v
retrieving revision 1.5.2.1
diff -u -w -r1.5.2.1 macros.c
--- macros.c 1998/09/06 03:04:00 1.5.2.1
+++ macros.c 2000/03/20 12:16:12
@@ -287,7 +287,7 @@
executing_macro_index = 0;
con->prefix_arg = Qnil;
internal_catch (Qexecute_kbd_macro, call_command_loop,
- Qnil, 0);
+ Qnil, 0, 0);
}
while (--repeat != 0
&& (STRINGP (Vexecuting_macro) ||
Index: src/process-unix.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/process-unix.c,v
retrieving revision 1.11.2.18
diff -u -w -r1.11.2.18 process-unix.c
--- process-unix.c 2000/03/01 18:22:05 1.11.2.18
+++ process-unix.c 2000/03/20 12:16:13
@@ -72,6 +72,9 @@
int connected_via_filedesc_p;
/* Descriptor by which we read from this process. -1 for dead process */
int infd;
+ /* Descriptor by which we read stderr from this process. -1 for
+ dead process */
+ int errfd;
/* Descriptor for the tty which this process is using.
-1 if we didn't record it (on some systems, there's no need). */
int subtty;
@@ -131,7 +134,7 @@
{
Lisp_Object proc;
CVOID_TO_LISP (proc, contents);
- event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream,
+ event_stream_delete_io_streams (XPROCESS(proc)->pipe_instream,
XPROCESS(proc)->pipe_outstream);
return 0;
}
@@ -187,10 +190,11 @@
XPROCESS (proc)->pid = Fcons (infd, name);
XPROCESS (proc)->buffer = buffer;
- init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)XINT (outfd), 0);
+ init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)XINT (outfd),
+ (void*) -1, 0);
UNIX_DATA (XPROCESS (proc))->connected_via_filedesc_p = 1;
- event_stream_select_process (XPROCESS (proc));
+ event_stream_select_process (XPROCESS (proc), 1, 1);
return proc;
}
@@ -660,6 +664,7 @@
UNIX_DATA(p)->connected_via_filedesc_p = 0;
UNIX_DATA(p)->infd = -1;
+ UNIX_DATA(p)->errfd = -1;
UNIX_DATA(p)->subtty = -1;
UNIX_DATA(p)->tty_name = Qnil;
UNIX_DATA(p)->pty_flag = 0;
@@ -698,9 +703,11 @@
*/
static void
-unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
+unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, void *err,
+ int flags)
{
UNIX_DATA(p)->infd = (int)in;
+ UNIX_DATA(p)->errfd = (int)err;
}
/*
@@ -716,16 +723,19 @@
static int
unix_create_process (Lisp_Process *p,
Lisp_Object *argv, int nargv,
- Lisp_Object program, Lisp_Object cur_dir)
+ Lisp_Object program, Lisp_Object cur_dir,
+ int separate_err)
{
/* This function rewritten by ben(a)xemacs.org. */
int pid;
int inchannel = -1;
int outchannel = -1;
+ int errchannel = -1;
/* Use volatile to protect variables from being clobbered by longjmp. */
volatile int forkin = -1;
volatile int forkout = -1;
+ volatile int forkerr = -1;
volatile int pty_flag = 0;
#ifdef HAVE_PTYS
@@ -763,6 +773,16 @@
&forkin, &forkout) < 0)
goto io_failure;
+ if (separate_err)
+ {
+ int sv[2];
+
+ if (pipe (sv) < 0)
+ goto io_failure;
+ forkerr = sv[1];
+ errchannel = sv[0];
+ }
+
#if 0
/* Replaced by close_process_descs */
set_exclusive_use (inchannel);
@@ -770,10 +790,13 @@
#endif
set_descriptor_non_blocking (inchannel);
+ if (errchannel >= 0)
+ set_descriptor_non_blocking (errchannel);
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
init_process_io_handles (p, (void*)inchannel, (void*)outchannel,
+ (void *) errchannel,
pty_flag ? STREAM_PTY_FLUSHING : 0);
/* Record the tty descriptor used in the subprocess. */
UNIX_DATA(p)->subtty = forkin;
@@ -791,6 +814,7 @@
/**** Now we're in the child process ****/
int xforkin = forkin;
int xforkout = forkout;
+ int xforkerr = forkerr;
if (!pty_flag)
EMACS_SEPARATE_PROCESS_GROUP ();
@@ -932,7 +956,8 @@
C_STRING_ALLOCA, current_dir,
Qfile_name);
- child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
+ child_setup (xforkin, xforkout, separate_err ? xforkerr : xforkout,
+ new_argv, current_dir);
}
} /**** End of child code ****/
@@ -945,7 +970,10 @@
if (pid < 0)
{
+ /* #### why don't we close inchannel, outchannel? */
close_descriptor_pair (forkin, forkout);
+ if (separate_err)
+ close_descriptor_pair (forkerr, errchannel);
report_file_error ("Doing fork", Qnil);
}
@@ -960,6 +988,9 @@
close_safely (forkin);
if (forkin != forkout && forkout >= 0)
close (forkout);
+ /* #### why don't we close inchannel, outchannel? */
+ if (separate_err)
+ close_descriptor_pair (forkerr, errchannel);
#ifdef HAVE_PTYS
if (pty_flag)
@@ -980,6 +1011,7 @@
int save_errno = errno;
close_descriptor_pair (forkin, forkout);
close_descriptor_pair (inchannel, outchannel);
+ close_descriptor_pair (forkerr, errchannel);
errno = save_errno;
report_file_error ("Opening pty or pipe", Qnil);
return 0; /* not reached */
@@ -1000,6 +1032,7 @@
unix_set_window_size (Lisp_Process* p, int cols, int rows)
{
return set_window_size (UNIX_DATA(p)->infd, cols, rows);
+ /* ### what about errfd? */
}
/*
@@ -1234,29 +1267,34 @@
* inactive state.
*
* The return value is a unique stream ID, as returned by
- * event_stream_delete_stream_pair
+ * event_stream_delete_io_streams
*
- * In the lack of this method, only event_stream_delete_stream_pair
+ * In the lack of this method, only event_stream_delete_io_streams
* is called on both I/O streams of the process.
*
* The UNIX version guards this by ignoring possible SIGPIPE.
*/
-static USID
-unix_deactivate_process (Lisp_Process *p)
+static void
+unix_deactivate_process (Lisp_Process *p,
+ USID* in_usid,
+ USID* err_usid)
{
SIGTYPE (*old_sigpipe) (int) = 0;
- USID usid;
if (UNIX_DATA(p)->infd >= 0)
flush_pending_output (UNIX_DATA(p)->infd);
+ if (UNIX_DATA(p)->errfd >= 0)
+ flush_pending_output (UNIX_DATA(p)->errfd);
/* closing the outstream could result in SIGPIPE, so ignore it. */
old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, SIG_IGN);
- usid = event_stream_delete_stream_pair (p->pipe_instream, p->pipe_outstream);
+ event_stream_delete_io_streams (p->pipe_instream, p->pipe_outstream,
+ in_usid, err_usid);
signal (SIGPIPE, old_sigpipe);
UNIX_DATA(p)->infd = -1;
+ UNIX_DATA(p)->errfd = -1;
return usid;
}
@@ -1351,6 +1389,7 @@
case SIGQUIT:
case SIGKILL:
flush_pending_output (UNIX_DATA(p)->infd);
+ flush_pending_output (UNIX_DATA(p)->errfd);
break;
}
Index: src/process.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/process.c,v
retrieving revision 1.39.2.12
diff -u -w -r1.39.2.12 process.c
--- process.c 2000/02/21 23:06:59 1.39.2.12
+++ process.c 2000/03/20 12:16:14
@@ -99,7 +99,7 @@
/* Nonzero means delete a process right away if it exits. */
int delete_exited_processes;
-/* Hash table which maps USIDs as returned by create_stream_pair_cb to
+/* Hash table which maps USIDs as returned by create_io_streams_cb to
process objects. Processes are not GC-protected through this! */
struct hash_table *usid_to_process;
@@ -118,15 +118,20 @@
mark_object (proc->name);
mark_object (proc->command);
mark_object (proc->filter);
+ mark_object (proc->stderr_filter);
mark_object (proc->sentinel);
mark_object (proc->buffer);
mark_object (proc->mark);
+ mark_object (proc->stderr_buffer);
+ mark_object (proc->stderr_mark);
mark_object (proc->pid);
mark_object (proc->pipe_instream);
mark_object (proc->pipe_outstream);
+ mark_object (proc->pipe_errstream);
#ifdef FILE_CODING
mark_object (proc->coding_instream);
mark_object (proc->coding_outstream);
+ mark_object (proc->coding_errstream);
#endif
return proc->status_symbol;
}
@@ -196,15 +201,20 @@
directly to the child process, rather than en/decoding FILE_CODING
streams */
void
-get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr)
+get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr,
+ Lisp_Object *errstr)
{
assert (p);
assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream));
assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
+ assert (NILP (p->pipe_errstream) || LSTREAMP(p->pipe_errstream));
*instr = p->pipe_instream;
*outstr = p->pipe_outstream;
+ *errstr = p->pipe_errstream;
}
+/* Given a USID referring to either a process's instream or errstream,
+ return the associated process. */
Lisp_Process *
get_process_from_usid (USID usid)
{
@@ -223,15 +233,16 @@
}
int
-get_process_selected_p (Lisp_Process *p)
+get_process_selected_p (Lisp_Process *p, int do_err)
{
- return p->selected;
+ return do_err ? p->err_selected : p->in_selected;
}
void
-set_process_selected_p (Lisp_Process *p, int selected_p)
+set_process_selected_p (Lisp_Process *p, int in_selected, int err_selected)
{
- p->selected = !!selected_p;
+ p->in_selected = !!in_selected;
+ p->err_selected = !!err_selected;
}
int
@@ -441,23 +452,30 @@
p->command = Qnil;
p->filter = Qnil;
+ p->stderr_filter = Qnil;
p->sentinel = Qnil;
p->buffer = Qnil;
p->mark = Fmake_marker ();
+ p->stderr_buffer = Qnil;
+ p->stderr_mark = Fmake_marker ();
p->pid = Qnil;
p->status_symbol = Qrun;
p->exit_code = 0;
p->core_dumped = 0;
p->filter_does_read = 0;
p->kill_without_query = 0;
- p->selected = 0;
+ p->separate_stderr = 0;
+ p->in_selected = 0;
+ p->err_selected = 0;
p->tick = 0;
p->update_tick = 0;
p->pipe_instream = Qnil;
p->pipe_outstream = Qnil;
+ p->pipe_errstream = Qnil;
#ifdef FILE_CODING
p->coding_instream = Qnil;
p->coding_outstream = Qnil;
+ p->coding_errstream = Qnil;
#endif
p->process_data = 0;
@@ -470,40 +488,64 @@
}
void
-init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
+init_process_io_handles (Lisp_Process *p, void* in, void* out, void* err,
+ int flags)
{
- USID usid = event_stream_create_stream_pair (in, out,
- &p->pipe_instream, &p->pipe_outstream,
+ USID in_usid, err_usid;
+
+ event_stream_create_io_streams (in, out, err,
+ &p->pipe_instream,
+ &p->pipe_outstream,
+ &p->pipe_errstream,
+ &in_usid, &err_usid,
flags);
+
+ if (in_usid == USID_ERROR || err_usid == USID_ERROR)
+ {
+ Lisp_Object proc;
+
+ XSETPROCESS (proc, p);
+ report_file_error ("Setting up communication with subprocess", proc);
+ }
- if (usid == USID_ERROR)
- report_file_error ("Setting up communication with subprocess", Qnil);
+ if (in_usid != USID_DONTHASH)
+ {
+ Lisp_Object proc = Qnil;
+ XSETPROCESS (proc, p);
+ puthash ((const void*)in_usid, LISP_TO_VOID (proc), usid_to_process);
+ }
- if (usid != USID_DONTHASH)
+ if (err_usid != USID_DONTHASH)
{
Lisp_Object proc = Qnil;
XSETPROCESS (proc, p);
- puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process);
+ puthash ((const void*)err_usid, LISP_TO_VOID (proc), usid_to_process);
}
- MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags));
+ MAYBE_PROCMETH (init_process_io_handles, (p, in, out, err, flags));
#ifdef FILE_CODING
p->coding_instream = make_decoding_input_stream
(XLSTREAM (p->pipe_instream),
Fget_coding_system (Vcoding_system_for_read));
Lstream_set_character_mode (XLSTREAM (p->coding_instream));
+ if (!NILP (p->pipe_errstream))
+ {
+ p->coding_errstream = make_decoding_input_stream
+ (XLSTREAM (p->pipe_errstream),
+ Fget_coding_system (Vcoding_system_for_read));
+ Lstream_set_character_mode (XLSTREAM (p->coding_errstream));
+ }
p->coding_outstream = make_encoding_output_stream
(XLSTREAM (p->pipe_outstream),
Fget_coding_system (Vcoding_system_for_write));
- /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
- What's going on here? */
#endif /* FILE_CODING */
}
static void
create_process (Lisp_Object process, Lisp_Object *argv, int nargv,
- Lisp_Object program, Lisp_Object cur_dir)
+ Lisp_Object program, Lisp_Object cur_dir,
+ int separate_err)
{
Lisp_Process *p = XPROCESS (process);
int pid;
@@ -513,11 +555,12 @@
p->status_symbol = Qrun;
p->exit_code = 0;
- pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir));
+ pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir,
+ separate_err));
p->pid = make_int (pid);
if (PROCESS_LIVE_P (p))
- event_stream_select_process (p);
+ event_stream_select_process (p, 1, 1);
}
/* This function is the unwind_protect form for Fstart_process_internal. If
@@ -542,17 +585,27 @@
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
- with any buffer
+ with any buffer.
+BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case,
+ REAL-BUFFER says what to do with standard output, as above,
+ while STDERR-BUFFER says what to do with standard error in the child.
+ STDERR-BUFFER may be nil (discard standard error output, unless a stderr
+ filter is set). Note that if you do not use this form at process creation,
+ stdout and stderr will be mixed in the output buffer, and this cannot be
+ changed, even by setting a stderr filter.
Third arg is program file name. It is searched for as in the shell.
Remaining arguments are strings to give program as arguments.
INCODE and OUTCODE specify the coding-system objects used in input/output
from/to the process.
+
+See also `set-process-filter' and `set-process-stderr-filter'.
*/
(int nargs, Lisp_Object *args))
{
/* This function can call lisp */
/* !!#### This function has not been Mule-ized */
- Lisp_Object buffer, name, program, proc, current_dir;
+ Lisp_Object buffer, stderr_buffer, name, program, proc, current_dir;
+ int separate_stderr;
Lisp_Object tem;
int speccount = specpdl_depth ();
struct gcpro gcpro1, gcpro2, gcpro3;
@@ -565,8 +618,28 @@
/* Protect against various file handlers doing GCs below. */
GCPRO3 (buffer, program, current_dir);
+ if (CONSP (buffer))
+ {
+ if (!CONSP (XCDR (buffer)))
+ signal_simple_error ("Invalid BUFFER argument to `start-process'",
+ buffer);
+ if (!NILP (XCDR (XCDR (buffer))))
+ signal_simple_error ("Invalid BUFFER argument to `start-process'",
+ buffer);
+ stderr_buffer = XCAR (XCDR (buffer));
+ buffer = XCAR (buffer);
+ separate_stderr = 1;
+ }
+ else
+ {
+ stderr_buffer = Qnil;
+ separate_stderr = 0;
+ }
+
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
+ if (!NILP (stderr_buffer))
+ stderr_buffer = Fget_buffer_create (stderr_buffer);
CHECK_STRING (name);
CHECK_STRING (program);
@@ -614,6 +687,8 @@
proc = make_process_internal (name);
XPROCESS (proc)->buffer = buffer;
+ XPROCESS (proc)->stderr_buffer = stderr_buffer;
+ XPROCESS (proc)->separate_stderr = separate_stderr;
XPROCESS (proc)->command = Flist (nargs - 2,
args + 2);
@@ -621,6 +696,9 @@
if (!NILP (buffer))
Fset_marker (XPROCESS (proc)->mark,
make_int (BUF_ZV (XBUFFER (buffer))), buffer);
+ if (!NILP (stderr_buffer))
+ Fset_marker (XPROCESS (proc)->stderr_mark,
+ make_int (BUF_ZV (XBUFFER (stderr_buffer))), stderr_buffer);
/* If an error occurs and we can't start the process, we want to
remove it from the process list. This means that each error
@@ -628,7 +706,8 @@
itself; it's all taken care of here. */
record_unwind_protect (start_process_unwind, proc);
- create_process (proc, args + 3, nargs - 3, program, current_dir);
+ create_process (proc, args + 3, nargs - 3, program, current_dir,
+ separate_stderr);
UNGCPRO;
return unbind_to (speccount, proc);
@@ -717,9 +796,10 @@
XPROCESS (proc)->pid = Fcons (service, host);
XPROCESS (proc)->buffer = buffer;
init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch,
+ (void *) -1,
STREAM_NETWORK_CONNECTION);
- event_stream_select_process (XPROCESS (proc));
+ event_stream_select_process (XPROCESS (proc), 1, 1);
UNGCPRO;
NUNGCPRO;
@@ -767,10 +847,10 @@
XPROCESS (proc)->pid = Fcons (port, dest);
XPROCESS (proc)->buffer = buffer;
- init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch,
+ init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 0,
STREAM_NETWORK_CONNECTION);
- event_stream_select_process (XPROCESS (proc));
+ event_stream_select_process (XPROCESS (proc), 1, 1);
UNGCPRO;
return proc;
@@ -804,8 +884,7 @@
/* Process I/O */
/************************************************************************/
-/* Read pending output from the process channel,
- starting with our buffered-ahead character if we have one.
+/* Read pending output from the process channel.
Yield number of characters read.
This function reads at most 1024 bytes.
@@ -813,14 +892,18 @@
you must call it repeatedly until it returns zero. */
Charcount
-read_process_output (Lisp_Object proc)
+read_process_output (Lisp_Object proc, int read_stderr)
{
/* This function can GC */
Bytecount nbytes, nchars;
Bufbyte chars[1024];
Lisp_Object outstream;
Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object filter = read_stderr ? p->stderr_filter : p->filter;
+ Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer;
+ Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark;
+
/* If there is a lot of output from the subprocess, the loop in
execute_internal_event() might call read_process_output() more
than once. If the filter that was executed from one of these
@@ -830,42 +913,44 @@
for a process-filter change, like in status_notify(); but the
struct Lisp_Process is not exported outside of this file. */
if (!PROCESS_LIVE_P (p))
+ {
+ errno = 0;
return -1; /* already closed */
+ }
- if (!NILP (p->filter) && (p->filter_does_read))
+ if (!NILP (filter) && (p->filter_does_read))
{
Lisp_Object filter_result;
/* Some weird FSFmacs crap here with
- Vdeactivate_mark and current_buffer->keymap */
- running_asynch_code = 1;
- filter_result = call2_trapping_errors ("Error in process filter",
- p->filter, proc, Qnil);
- running_asynch_code = 0;
- restore_match_data ();
+ Vdeactivate_mark and current_buffer->keymap.
+ Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
+ /* Don't catch errors here; we're not in any critical code. */
+ filter_result = call2 (filter, proc, Qnil);
CHECK_INT (filter_result);
return XINT (filter_result);
}
- nbytes = Lstream_read (XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars));
+ nbytes = Lstream_read (read_stderr ? XLSTREAM (DATA_ERRSTREAM(p)) :
+ XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars));
if (nbytes <= 0) return nbytes;
nchars = bytecount_to_charcount (chars, nbytes);
- outstream = p->filter;
+ outstream = filter;
if (!NILP (outstream))
{
- /* We used to bind inhibit-quit to t here, but
- call2_trapping_errors() does that for us. */
- running_asynch_code = 1;
- call2_trapping_errors ("Error in process filter",
- outstream, proc, make_string (chars, nbytes));
- running_asynch_code = 0;
- restore_match_data ();
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
+ /* Don't catch errors here; we're not in any critical code. */
+ call2 (outstream, proc, make_string (chars, nbytes));
return nchars;
}
/* If no filter, write into buffer if it isn't dead. */
- if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
+ if (!NILP (buffer) && BUFFER_LIVE_P (XBUFFER (buffer)))
{
Lisp_Object old_read_only = Qnil;
Bufpos old_point;
@@ -873,7 +958,7 @@
Bufpos old_zv;
int old_zmacs_region_stays = zmacs_region_stays;
struct gcpro gcpro1, gcpro2;
- struct buffer *buf = XBUFFER (p->buffer);
+ struct buffer *buf = XBUFFER (buffer);
GCPRO2 (proc, old_read_only);
@@ -886,9 +971,9 @@
/* Insert new output into buffer
at the current end-of-output marker,
thus preserving logical ordering of input and output. */
- if (XMARKER (p->mark)->buffer)
+ if (XMARKER (mark)->buffer)
BUF_SET_PT (buf,
- bufpos_clip_to_bounds (old_begv, marker_position (p->mark),
+ bufpos_clip_to_bounds (old_begv, marker_position (mark),
old_zv));
else
BUF_SET_PT (buf, old_zv);
@@ -897,7 +982,7 @@
the restriction and widen. */
if (! (BUF_BEGV (buf) <= BUF_PT (buf) &&
BUF_PT (buf) <= BUF_ZV (buf)))
- Fwiden (p->buffer);
+ Fwiden (buffer);
/* Make sure opoint floats ahead of any new text, just as point
would. */
@@ -921,14 +1006,14 @@
buffer_insert_raw_string (buf, chars, nbytes);
#endif
- Fset_marker (p->mark, make_int (BUF_PT (buf)), p->buffer);
+ Fset_marker (mark, make_int (BUF_PT (buf)), buffer);
MARK_MODELINE_CHANGED;
/* If the restriction isn't what it should be, set it. */
if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf))
{
- Fwiden(p->buffer);
+ Fwiden(buffer);
old_begv = bufpos_clip_to_bounds (BUF_BEG (buf),
old_begv,
BUF_Z (buf));
@@ -936,7 +1021,7 @@
old_zv,
BUF_Z (buf));
Fnarrow_to_region (make_int (old_begv), make_int (old_zv),
- p->buffer);
+ buffer);
}
/* Handling the process output should not deactivate the mark. */
@@ -952,6 +1037,13 @@
return nchars;
}
+int
+process_has_separate_stderr (Lisp_Object proc)
+{
+ return XPROCESS (proc)->separate_stderr;
+}
+
+
/* Sending data to subprocess */
/* send some data to process PROC. If NONRELOCATABLE is non-NULL, it
@@ -1025,6 +1117,33 @@
return XPROCESS (proc)->buffer;
}
+DEFUN ("set-process-stderr-buffer", Fset_process_stderr_buffer, 2, 2, 0, /*
+Set stderr buffer associated with PROCESS to BUFFER (a buffer, or nil).
+*/
+ (proc, buffer))
+{
+ CHECK_PROCESS (proc);
+ if (!XPROCESS (proc)->separate_stderr)
+ signal_simple_error ("stdout and stderr not separate", proc);
+ if (!NILP (buffer))
+ CHECK_BUFFER (buffer);
+ XPROCESS (proc)->stderr_buffer = buffer;
+ return buffer;
+}
+
+DEFUN ("process-stderr-buffer", Fprocess_stderr_buffer, 1, 1, 0, /*
+Return the stderr buffer PROCESS is associated with.
+Output from the stderr of PROCESS is inserted in this buffer
+unless PROCESS has a stderr filter.
+*/
+ (proc))
+{
+ CHECK_PROCESS (proc);
+ if (!XPROCESS (proc)->separate_stderr)
+ signal_simple_error ("stdout and stderr not separate", proc);
+ return XPROCESS (proc)->stderr_buffer;
+}
+
DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /*
Return the marker for the end of the last output from PROCESS.
*/
@@ -1034,23 +1153,58 @@
return XPROCESS (proc)->mark;
}
+DEFUN ("process-stderr-mark", Fprocess_stderr_mark, 1, 1, 0, /*
+Return the marker for the end of the last stderr output from PROCESS.
+*/
+ (proc))
+{
+ CHECK_PROCESS (proc);
+ if (!XPROCESS (proc)->separate_stderr)
+ signal_simple_error ("stdout and stderr not separate", proc);
+ return XPROCESS (proc)->stderr_mark;
+}
+
void
-set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read)
+set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read,
+ int set_stderr)
{
CHECK_PROCESS (proc);
- if (PROCESS_LIVE_P (XPROCESS (proc))) {
+ if (set_stderr && !XPROCESS (proc)->separate_stderr)
+ signal_simple_error ("stdout and stderr not separate", proc);
+ if (PROCESS_LIVE_P (XPROCESS (proc)))
+ {
if (EQ (filter, Qt))
- event_stream_unselect_process (XPROCESS (proc));
+ event_stream_unselect_process (XPROCESS (proc), !set_stderr,
+ set_stderr);
else
- event_stream_select_process (XPROCESS (proc));
+ event_stream_select_process (XPROCESS (proc), !set_stderr,
+ set_stderr);
}
+ if (set_stderr)
+ XPROCESS (proc)->stderr_filter = filter;
+ else
XPROCESS (proc)->filter = filter;
XPROCESS (proc)->filter_does_read = filter_does_read;
}
DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /*
Give PROCESS the filter function FILTER; nil means no filter.
+t means stop accepting output from the process. (If process was created
+with
+When a process has a filter, each time it does output
+the entire string of output is passed to the filter.
+The filter gets two arguments: the process and the string of output.
+If the process has a filter, its buffer is not used for output.
+*/
+ (proc, filter))
+{
+ set_process_filter (proc, filter, 0, 0);
+ return filter;
+}
+
+DEFUN ("set-process-stderr-filter", Fset_process_stderr_filter, 2, 2, 0, /*
+Give PROCESS the stderr filter function FILTER; nil means no filter.
t means stop accepting output from the process.
When a process has a filter, each time it does output
the entire string of output is passed to the filter.
@@ -1059,7 +1213,7 @@
*/
(proc, filter))
{
- set_process_filter (proc, filter, 0);
+ set_process_filter (proc, filter, 0, 1);
return filter;
}
@@ -1073,24 +1227,37 @@
return XPROCESS (proc)->filter;
}
-DEFUN ("process-send-region", Fprocess_send_region, 3, 3, 0, /*
-Send current contents of region as input to PROCESS.
+DEFUN ("process-stderr-filter", Fprocess_stderr_filter, 1, 1, 0, /*
+Return the filter function of PROCESS; nil if none.
+See `set-process-stderr-filter' for more info on filter functions.
+*/
+ (proc))
+{
+ CHECK_PROCESS (proc);
+ if (!XPROCESS (proc)->separate_stderr)
+ signal_simple_error ("stdout and stderr not separate", proc);
+ return XPROCESS (proc)->stderr_filter;
+}
+
+DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /*
+Send current contents of the region between START and END as input to PROCESS.
PROCESS may be a process name or an actual process.
-Called from program, takes three arguments, PROCESS, START and END.
+BUFFER specifies the buffer to look in; if nil, the current buffer is used.
If the region is more than 500 or so characters long,
it is sent in several bunches. This may happen even for shorter regions.
Output from processes can arrive in between bunches.
*/
- (process, start, end))
+ (process, start, end, buffer))
{
/* This function can GC */
Lisp_Object proc = get_process (process);
Bufpos st, en;
+ struct buffer *buf = decode_buffer (buffer, 0);
- get_buffer_range_char (current_buffer, start, end, &st, &en, 0);
+ XSETBUFFER (buffer, buf);
+ get_buffer_range_char (buf, start, end, &st, &en, 0);
- send_process (proc, Fcurrent_buffer (), 0,
- st, en - st);
+ send_process (proc, buffer, 0, st, en - st);
return Qnil;
}
@@ -1128,7 +1295,8 @@
{
process = get_process (process);
CHECK_LIVE_PROCESS (process);
- return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream)
);
+ return decoding_stream_coding_system
+ (XLSTREAM (XPROCESS (process)->coding_instream));
}
DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0,
/*
@@ -1138,7 +1306,8 @@
{
process = get_process (process);
CHECK_LIVE_PROCESS (process);
- return encoding_stream_coding_system (XLSTREAM (XPROCESS
(process)->coding_outstream));
+ return encoding_stream_coding_system
+ (XLSTREAM (XPROCESS (process)->coding_outstream));
}
DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
@@ -1230,16 +1399,19 @@
/* Some weird FSFmacs crap here with
Vdeactivate_mark and current_buffer->keymap */
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
+
/* Zilch the sentinel while it's running, to avoid recursive invocations;
- assure that it gets restored no matter how the sentinel exits. */
+ assure that it gets restored no matter how the sentinel exits.
+
+ (#### Why is this necessary? Probably another relic of asynchronous
+ calling of process filters/sentinels.) */
p->sentinel = Qnil;
record_unwind_protect (exec_sentinel_unwind, noseeum_cons (proc, sentinel));
- /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
- does that for us. */
- running_asynch_code = 1;
- call2_trapping_errors ("Error in process sentinel", sentinel, proc, reason);
- running_asynch_code = 0;
- restore_match_data ();
+ /* Don't catch errors here; we're not in any critical code. */
+ call2 (sentinel, proc, reason);
unbind_to (speccount, Qnil);
}
@@ -1328,7 +1500,7 @@
/* Tell status_notify() to check for terminated processes. We do this
because on some systems we sometimes miss SIGCHLD calls. (Not sure
- why.) */
+ why.) This is also used under Mswin. */
void
kick_status_notify (void)
@@ -1392,8 +1564,11 @@
/* If process is still active, read any output that remains. */
while (!EQ (p->filter, Qt)
- && read_process_output (proc) > 0)
+ && read_process_output (proc, 0) > 0)
;
+ while (p->separate_stderr && !EQ (p->stderr_filter, Qt)
+ && read_process_output (proc, 1) > 0)
+ ;
/* Get the text to use for the message. */
msg = status_message (p);
@@ -1812,8 +1987,11 @@
{
if (!NILP (DATA_OUTSTREAM (XPROCESS (proc))))
{
+ USID humpty, dumpty;
Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (proc))));
- event_stream_delete_stream_pair (Qnil, XPROCESS (proc)->pipe_outstream);
+ event_stream_delete_io_streams (Qnil,
+ XPROCESS (proc)->pipe_outstream,
+ Qnil, &humpty, &dumpty);
XPROCESS (proc)->pipe_outstream = Qnil;
#ifdef FILE_CODING
XPROCESS (proc)->coding_outstream = Qnil;
@@ -1833,7 +2011,7 @@
deactivate_process (Lisp_Object proc)
{
Lisp_Process *p = XPROCESS (proc);
- USID usid;
+ USID in_usid, err_usid;
/* It's possible that we got as far in the process-creation
process as creating the descriptors but didn't get so
@@ -1841,31 +2019,39 @@
case, p->pid is nil: p->pid is set at the same time that
the process is selected for input. */
/* #### The comment does not look correct. event_stream_unselect_process
- is guarded by process->selected, so this is not a problem. - kkm*/
+ is guarded by process->*_selected, so this is not a problem. - kkm*/
/* Must call this before setting the streams to nil */
- event_stream_unselect_process (p);
+ event_stream_unselect_process (p, 1, 1);
if (!NILP (DATA_OUTSTREAM (p)))
Lstream_close (XLSTREAM (DATA_OUTSTREAM (p)));
if (!NILP (DATA_INSTREAM (p)))
Lstream_close (XLSTREAM (DATA_INSTREAM (p)));
+ if (!NILP (DATA_ERRSTREAM (p)))
+ Lstream_close (XLSTREAM (DATA_ERRSTREAM (p)));
/* Provide minimal implementation for deactivate_process
if there's no process-specific one */
if (HAS_PROCMETH_P (deactivate_process))
- usid = PROCMETH (deactivate_process, (p));
+ PROCMETH (deactivate_process, (p, &in_usid, &err_usid));
else
- usid = event_stream_delete_stream_pair (p->pipe_instream,
- p->pipe_outstream);
-
- if (usid != USID_DONTHASH)
- remhash ((const void*)usid, usid_to_process);
+ event_stream_delete_io_streams (p->pipe_instream,
+ p->pipe_outstream,
+ p->pipe_errstream,
+ &in_usid, &err_usid);
+
+ if (in_usid != USID_DONTHASH)
+ remhash ((const void*)in_usid, usid_to_process);
+ if (err_usid != USID_DONTHASH)
+ remhash ((const void*)err_usid, usid_to_process);
p->pipe_instream = Qnil;
p->pipe_outstream = Qnil;
+ p->pipe_errstream = Qnil;
#ifdef FILE_CODING
p->coding_instream = Qnil;
p->coding_outstream = Qnil;
+ p->coding_errstream = Qnil;
#endif
}
@@ -2018,10 +2204,15 @@
DEFSUBR (Fprocess_tty_name);
DEFSUBR (Fprocess_command);
DEFSUBR (Fset_process_buffer);
+ DEFSUBR (Fset_process_stderr_buffer);
DEFSUBR (Fprocess_buffer);
DEFSUBR (Fprocess_mark);
+ DEFSUBR (Fprocess_stderr_buffer);
+ DEFSUBR (Fprocess_stderr_mark);
DEFSUBR (Fset_process_filter);
DEFSUBR (Fprocess_filter);
+ DEFSUBR (Fset_process_stderr_filter);
+ DEFSUBR (Fprocess_stderr_filter);
DEFSUBR (Fset_process_window_size);
DEFSUBR (Fset_process_sentinel);
DEFSUBR (Fprocess_sentinel);
Index: src/procimpl.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/procimpl.h,v
retrieving revision 1.3.2.6
diff -u -w -r1.3.2.6 procimpl.h
--- procimpl.h 2000/02/16 02:07:13 1.3.2.6
+++ procimpl.h 2000/03/20 12:16:14
@@ -40,10 +40,11 @@
void (*finalize_process_data) (Lisp_Process *proc, int for_disksave);
void (*alloc_process_data) (Lisp_Process *p);
void (*init_process_io_handles) (Lisp_Process *p,
- void* in, void* out, int flags);
+ void* in, void* out, void *err, int flags);
int (*create_process) (Lisp_Process *p,
Lisp_Object *argv, int nargv,
- Lisp_Object program, Lisp_Object cur_dir);
+ Lisp_Object program, Lisp_Object cur_dir,
+ int separate_err);
int (*tooltalk_connection_p) (Lisp_Process *p);
#ifdef HAVE_SOCKETS
void (*open_network_stream) (Lisp_Object name, Lisp_Object host,
@@ -65,7 +66,9 @@
int (*kill_process_by_pid) (int pid, int sigcode);
int (*process_send_eof) (Lisp_Object proc);
Lisp_Object (*get_tty_name) (Lisp_Process *p);
- USID (*deactivate_process) (Lisp_Process *p);
+ void (*deactivate_process) (Lisp_Process *p,
+ USID* in_usid,
+ USID* err_usid);
void (*init_process) (void);
};
@@ -98,12 +101,15 @@
/* (funcall FILTER PROC STRING) (if FILTER is non-nil)
to dispose of a bunch of chars from the process all at once */
Lisp_Object filter;
+ /* (funcall FILTER PROC STRING) (if FILTER is non-nil)
+ to dispose of a bunch of chars from the stderr of process all at once */
+ Lisp_Object stderr_filter;
/* (funcall SENTINEL PROCESS) when process state changes */
Lisp_Object sentinel;
- /* Buffer that output is going to */
- Lisp_Object buffer;
+ /* Buffer that output or stderr output is going to */
+ Lisp_Object buffer, stderr_buffer;
/* Marker set to end of last buffer-inserted output from this process */
- Lisp_Object mark;
+ Lisp_Object mark, stderr_mark;
/* Lisp_Int of subprocess' PID, or a cons of
service/host if this is really a network connection */
Lisp_Object pid;
@@ -124,20 +130,24 @@
channel, rather than having a call to make_string.
This only works if the filter is a subr. */
char filter_does_read;
- /* Non-nil means kill silently if Emacs is exited. */
+ /* Non-zero means kill silently if Emacs is exited. */
char kill_without_query;
- char selected;
+ char in_selected, err_selected;
/* Event-count of last event in which this process changed status. */
volatile int tick;
/* Event-count of last such event reported. */
int update_tick;
+ /* Non-zero if stderr and stdout are separated. */
+ char separate_stderr;
/* Low level streams used in input and output, connected to child */
Lisp_Object pipe_instream;
Lisp_Object pipe_outstream;
+ Lisp_Object pipe_errstream;
#ifdef FILE_CODING
/* Data end streams, decoding and encoding pipe_* streams */
Lisp_Object coding_instream;
Lisp_Object coding_outstream;
+ Lisp_Object coding_errstream;
#endif
/* Implementation dependent data */
@@ -148,9 +158,11 @@
#ifdef FILE_CODING
#define DATA_INSTREAM(p) (p)->coding_instream
#define DATA_OUTSTREAM(p) (p)->coding_outstream
+#define DATA_ERRSTREAM(p) (p)->coding_errstream
#else
#define DATA_INSTREAM(p) (p)->pipe_instream
#define DATA_OUTSTREAM(p) (p)->pipe_outstream
+#define DATA_ERRSTREAM(p) (p)->pipe_errstream
#endif
/* Random externs from process.c */
@@ -175,7 +187,7 @@
Lisp_Object make_process_internal (Lisp_Object name);
void init_process_io_handles (Lisp_Process *p, void* in,
- void* out, int flags);
+ void* out, void *err, int flags);
void send_process (Lisp_Object proc,
Lisp_Object relocatable,
const Bufbyte *nonrelocatable,
Index: src/search.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/search.c,v
retrieving revision 1.14.2.9
diff -u -w -r1.14.2.9 search.c
--- search.c 2000/02/16 02:07:14 1.14.2.9
+++ search.c 2000/03/20 12:16:14
@@ -280,8 +280,9 @@
REGISTER int i;
struct re_pattern_buffer *bufp;
- if (running_asynch_code)
- save_search_regs ();
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
CHECK_STRING (string);
bufp = compile_pattern (string, &search_regs,
@@ -362,8 +363,9 @@
Charcount s;
struct re_pattern_buffer *bufp;
- if (running_asynch_code)
- save_search_regs ();
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
CHECK_STRING (regexp);
CHECK_STRING (string);
@@ -1128,8 +1130,9 @@
Bytecount s1, s2;
Bytind pos, lim;
- if (running_asynch_code)
- save_search_regs ();
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
/* Null string is found at starting position. */
if (len == 0)
@@ -2382,8 +2385,9 @@
int num_regs;
int length;
- if (running_asynch_code)
- save_search_regs ();
+ /* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
CONCHECK_LIST (list);
Index: src/syssignal.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/syssignal.h,v
retrieving revision 1.7.2.5
diff -u -w -r1.7.2.5 syssignal.h
--- syssignal.h 2000/02/16 02:06:58 1.7.2.5
+++ syssignal.h 2000/03/20 12:16:14
@@ -236,12 +236,12 @@
#ifdef WINDOWSNT
/* Prototypes for signal functions, see nt.c */
-typedef void (__cdecl *msw_sighandler) (int);
-msw_sighandler msw_sigset (int sig, msw_sighandler handler);
-int msw_sighold (int nsig);
-int msw_sigrelse (int nsig);
-int msw_sigpause (int nsig);
-int msw_raise (int nsig);
+typedef void (__cdecl *mswindows_sighandler) (int);
+mswindows_sighandler mswindows_sigset (int sig, mswindows_sighandler handler);
+int mswindows_sighold (int nsig);
+int mswindows_sigrelse (int nsig);
+int mswindows_sigpause (int nsig);
+int mswindows_raise (int nsig);
#endif /* _WIN32 */
#endif /* INCLUDED_syssignal_h_ */
Index: src/toolbar.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/toolbar.c,v
retrieving revision 1.18.2.7
diff -u -w -r1.18.2.7 toolbar.c
--- toolbar.c 2000/02/21 23:06:51 1.18.2.7
+++ toolbar.c 2000/03/20 12:16:15
@@ -542,13 +542,15 @@
tb->enabled = !NILP (tb->enabled_p);
else
{
+ /* #### do we really need to protect this call? */
Lisp_Object result =
eval_in_buffer_trapping_errors
("Error in toolbar enabled-p form",
XBUFFER
(WINDOW_BUFFER
(XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)))),
- tb->enabled_p);
+ tb->enabled_p,
+ INHIBIT_THROWS);
if (UNBOUNDP (result))
/* #### if there was an error in the enabled-p
form, should we pretend like it's enabled
Index: src/tooltalk.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/tooltalk.c,v
retrieving revision 1.13.2.11
diff -u -w -r1.13.2.11 tooltalk.c
--- tooltalk.c 2000/02/21 23:07:00 1.13.2.11
+++ tooltalk.c 2000/03/20 12:16:16
@@ -1258,7 +1258,7 @@
/* Don't ask the user for confirmation when exiting Emacs */
Fprocess_kill_without_query (lp, Qnil);
XSETSUBR (fil, &SFreceive_tooltalk_message);
- set_process_filter (lp, fil, 1);
+ set_process_filter (lp, fil, 1, 0);
}
else
{
Index: src/nt.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/nt.c,v
retrieving revision 1.17.2.15
diff -u -w -r1.17.2.15 nt.c
--- nt.c 2000/03/12 23:10:42 1.17.2.15
+++ nt.c 2000/03/20 12:16:16
@@ -516,22 +516,6 @@
}
-/* Routines that are no-ops on NT but are defined to get Emacs to compile. */
-
-#if 0 /* #### We do not need those, do we? -kkm */
-int
-unrequest_sigio (void)
-{
- return 0;
-}
-
-int
-request_sigio (void)
-{
- return 0;
-}
-#endif /* 0 */
-
#define REG_ROOT "SOFTWARE\\GNU\\XEmacs"
LPBYTE
@@ -1406,8 +1390,8 @@
/* Since stat is encapsulated on Windows NT, we need to encapsulate
the equally broken fstat as well. */
-int _cdecl
-fstat (int handle, struct stat *buffer)
+int
+msw_fstat (int handle, struct stat *buffer)
{
int ret;
BY_HANDLE_FILE_INFORMATION lpFileInfo;
@@ -1442,7 +1426,7 @@
replace it with our own. This also allows us to calculate consistent
inode values without hacks in the main Emacs code. */
int
-stat (const char * path, struct stat * buf)
+msw_stat (const char * path, struct stat * buf)
{
char * name;
WIN32_FIND_DATA wfd;
@@ -1459,8 +1443,8 @@
}
name = (char *) map_win32_filename (path, &path);
- /* must be valid filename, no wild cards */
- if (strchr (name, '*') || strchr (name, '?'))
+ /* must be valid filename, no wild cards or other illegal characters */
+ if (strpbrk (name, "*?|<>\""))
{
errno = ENOENT;
return -1;
@@ -1802,7 +1786,7 @@
/* Signal pending mask: bit set to 1 means sig is pending */
unsigned signal_pending_mask = 0;
-msw_sighandler msw_sigset (int nsig, msw_sighandler handler)
+mswindows_sighandler mswindows_sigset (int nsig, mswindows_sighandler handler)
{
/* We delegate some signals to the system function */
if (nsig == SIGFPE || nsig == SIGABRT || nsig == SIGINT)
@@ -1816,13 +1800,13 @@
/* Store handler ptr */
{
- msw_sighandler old_handler = signal_handlers[nsig];
+ mswindows_sighandler old_handler = signal_handlers[nsig];
signal_handlers[nsig] = handler;
return old_handler;
}
}
-int msw_sighold (int nsig)
+int mswindows_sighold (int nsig)
{
if (nsig < 0 || nsig > SIG_MAX)
return errno = EINVAL;
@@ -1831,7 +1815,7 @@
return 0;
}
-int msw_sigrelse (int nsig)
+int mswindows_sigrelse (int nsig)
{
if (nsig < 0 || nsig > SIG_MAX)
return errno = EINVAL;
@@ -1839,12 +1823,12 @@
signal_block_mask &= ~sigmask(nsig);
if (signal_pending_mask & sigmask(nsig))
- msw_raise (nsig);
+ mswindows_raise (nsig);
return 0;
}
-int msw_sigpause (int nsig)
+int mswindows_sigpause (int nsig)
{
/* This is currently not called, because the only
call to sigpause inside XEmacs is with SIGCHLD
@@ -1855,7 +1839,7 @@
return 0;
}
-int msw_raise (int nsig)
+int mswindows_raise (int nsig)
{
/* We delegate some raises to the system routine */
if (nsig == SIGFPE || nsig == SIGABRT || nsig == SIGINT)
@@ -1921,7 +1905,7 @@
DWORD dw1, DWORD dw2)
{
/* Just raise a signal indicated by dwUser parameter */
- msw_raise (dwUser);
+ mswindows_raise (dwUser);
}
/* Divide time in ms specified by IT by DENOM. Return 1 ms
Index: src/console-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/console-msw.c,v
retrieving revision 1.4.2.7
diff -u -w -r1.4.2.7 console-msw.c
--- console-msw.c 2000/03/13 07:27:51 1.4.2.7
+++ console-msw.c 2000/03/20 12:16:16
@@ -46,7 +46,7 @@
return 1;
}
-static HWND msw_console_hwnd = 0;
+static HWND mswindows_console_hwnd = 0;
#define KLUDGE_BUFSIZE 1024 /* buffer size for console window titles */
@@ -88,15 +88,15 @@
}
HWND
-msw_get_console_hwnd (void)
+mswindows_get_console_hwnd (void)
{
- if (!msw_console_hwnd)
- msw_console_hwnd = GetConsoleHwnd ();
- return msw_console_hwnd;
+ if (!mswindows_console_hwnd)
+ mswindows_console_hwnd = GetConsoleHwnd ();
+ return mswindows_console_hwnd;
}
int
-msw_ensure_console_allocated (void)
+mswindows_ensure_console_allocated (void)
{
HWND fgwin = GetForegroundWindow ();
/* stupid mswin api won't let you create the console window
@@ -137,15 +137,15 @@
}
void
-msw_hide_console (void)
+mswindows_hide_console (void)
{
- ShowWindow (msw_get_console_hwnd (), SW_HIDE);
+ ShowWindow (mswindows_get_console_hwnd (), SW_HIDE);
}
void
-msw_show_console (void)
+mswindows_show_console (void)
{
- HWND hwnd = msw_get_console_hwnd ();
+ HWND hwnd = mswindows_get_console_hwnd ();
ShowWindow (hwnd, SW_SHOWNA);
/* I tried to raise the window to the top without activating
@@ -158,41 +158,41 @@
SWP_NOACTIVATE);
}
-static int msw_console_buffered = 0;
-HANDLE msw_console_buffer;
+static int mswindows_console_buffered = 0;
+HANDLE mswindows_console_buffer;
static void
-msw_ensure_console_buffered (void)
+mswindows_ensure_console_buffered (void)
{
- if (!msw_console_buffered)
+ if (!mswindows_console_buffered)
{
COORD new_size;
new_size.X = 80;
new_size.Y = 1000;
- msw_ensure_console_allocated ();
- msw_console_buffer =
+ mswindows_ensure_console_allocated ();
+ mswindows_console_buffer =
CreateConsoleScreenBuffer (GENERIC_WRITE, 0, NULL,
CONSOLE_TEXTMODE_BUFFER, NULL);
- SetConsoleScreenBufferSize (msw_console_buffer, new_size);
- SetConsoleActiveScreenBuffer (msw_console_buffer);
- msw_console_buffered = 1;
+ SetConsoleScreenBufferSize (mswindows_console_buffer, new_size);
+ SetConsoleActiveScreenBuffer (mswindows_console_buffer);
+ mswindows_console_buffered = 1;
}
}
int
-msw_output_console_string (CONST Extbyte *str, Extcount len)
+mswindows_output_console_string (CONST Extbyte *str, Extcount len)
{
DWORD num_written;
- msw_ensure_console_buffered ();
- msw_show_console ();
- return WriteConsole (msw_console_buffer, str, len, &num_written, NULL);
+ mswindows_ensure_console_buffered ();
+ mswindows_show_console ();
+ return WriteConsole (mswindows_console_buffer, str, len, &num_written, NULL);
}
/* Determine if running on Windows 9x and not NT */
int
-msw_windows9x_p (void)
+mswindows_windows9x_p (void)
{
return GetVersion () & 0x80000000;
}
Index: src/console-msw.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/console-msw.h,v
retrieving revision 1.22.2.19
diff -u -w -r1.22.2.19 console-msw.h
--- console-msw.h 2000/03/13 07:27:51 1.22.2.19
+++ console-msw.h 2000/03/20 12:16:16
@@ -285,6 +285,7 @@
int width, int height);
void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest);
void mswindows_enqueue_magic_event (HWND hwnd, UINT msg);
+int mswindows_is_dialog_msg (MSG *msg);
/* win32 DDE management library */
#define MSWINDOWS_DDE_ITEM_OPEN "Open"
@@ -302,37 +303,32 @@
Lisp_Object object);
Lisp_Object mswindows_cancel_dispatch_event (Lisp_Event* event);
Lisp_Object mswindows_pump_outstanding_events (void);
-Lisp_Object mswindows_protect_modal_loop (Lisp_Object (*bfun)
+Lisp_Object mswindows_protect_modal_loop (const char *error_string,
+ Lisp_Object (*bfun)
(Lisp_Object barg),
Lisp_Object barg);
void mswindows_unmodalize_signal_maybe (void);
COLORREF mswindows_string_to_color (const char *name);
-USID emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream,
- Lisp_Object* outstream,
- int flags);
-USID emacs_mswindows_delete_stream_pair (Lisp_Object instream,
- Lisp_Object outstream);
#ifdef HAVE_WIN32_PROCESSES
-HANDLE get_nt_process_handle (Lisp_Process *p);
+HANDLE get_nt_process_handle_only_first_time (Lisp_Process *p);
#endif
extern Lisp_Object Vmswindows_frame_being_created;
extern Lisp_Object mswindows_frame_being_created;
-void msw_get_workspace_coords (RECT *rc);
+void mswindows_get_workspace_coords (RECT *rc);
-HWND msw_get_console_hwnd (void);
-void msw_hide_console (void);
-void msw_show_console (void);
-int msw_output_console_string (CONST Extbyte *str, Extcount len);
+HWND mswindows_get_console_hwnd (void);
+void mswindows_hide_console (void);
+void mswindows_show_console (void);
+int mswindows_output_console_string (CONST Extbyte *str, Extcount len);
Lisp_Object mswindows_enumerate_fonts (HDC hdc);
-int msw_char_is_accelerator (struct frame *f, Emchar ch);
-Bytecount msw_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
+int mswindows_char_is_accelerator (struct frame *f, Emchar ch);
+Bytecount mswindows_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
Bytecount maxlen, Emchar *accel,
Lisp_Object error_name);
@@ -345,6 +341,6 @@
Lisp_Object mswindows_handle_gui_wm_command (struct frame* f,
HWND ctrl, LPARAM id);
-int msw_windows9x_p (void);
+int mswindows_windows9x_p (void);
#endif /* INCLUDED_console_msw_h_ */
Index: src/device-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/device-msw.c,v
retrieving revision 1.20.2.16
diff -u -w -r1.20.2.16 device-msw.c
--- device-msw.c 2000/03/13 07:27:52 1.20.2.16
+++ device-msw.c 2000/03/20 12:16:17
@@ -223,7 +223,7 @@
}
void
-msw_get_workspace_coords (RECT *rc)
+mswindows_get_workspace_coords (RECT *rc)
{
SystemParametersInfo (SPI_GETWORKAREA, 0, rc, 0);
}
@@ -298,7 +298,7 @@
case DM_size_workspace:
{
RECT rc;
- msw_get_workspace_coords (&rc);
+ mswindows_get_workspace_coords (&rc);
return Fcons (make_int (rc.right - rc.left),
make_int (rc.bottom - rc.top));
}
@@ -306,7 +306,7 @@
case DM_offset_workspace:
{
RECT rc;
- msw_get_workspace_coords (&rc);
+ mswindows_get_workspace_coords (&rc);
return Fcons (make_int (rc.left), make_int (rc.top));
}
Index: src/dialog-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/dialog-msw.c,v
retrieving revision 1.5.2.5
diff -u -w -r1.5.2.5 dialog-msw.c
--- dialog-msw.c 2000/03/13 07:27:52 1.5.2.5
+++ dialog-msw.c 2000/03/20 12:16:17
@@ -34,8 +34,9 @@
#include "opaque.h"
/* List containing all dialog data structures of currently popped up
- dialogs. Each item is a cons of frame object and a vector of
- callbacks for buttons in the dialog, in order */
+ dialogs. Each item is (frame object . (vector of callbacks for
+ buttons in the dialog, in order . opaque_ptr holding hwnd of
+ dialog)) */
static Lisp_Object Vdialog_data_list;
/* DLUs per character metrics */
@@ -110,6 +111,22 @@
#define ID_ITEM_BIAS 32
+/* Dispatch message to any dialog boxes. Return non-zero if dispatched. */
+int
+mswindows_is_dialog_msg (MSG *msg)
+{
+ Lisp_Object data, tail;
+
+ LIST_LOOP_3 (data, Vdialog_data_list, tail)
+ {
+ HWND dialog_hwnd = (HWND) get_opaque_ptr (XCDR (XCDR (data)));
+ if (IsDialogMessage (dialog_hwnd, msg))
+ return 1;
+ }
+
+ return 0;
+}
+
/* Dialog procedure */
static BOOL CALLBACK
dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
@@ -133,12 +150,17 @@
Lisp_Object fn, arg, data;
VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
+ if (w_param != IDCANCEL) /* user pressed escape */
+ {
assert (w_param >= ID_ITEM_BIAS
- && w_param < XVECTOR_LENGTH (XCDR (data)) + ID_ITEM_BIAS);
+ && w_param
+ < XVECTOR_LENGTH (XCAR (XCDR (data))) + ID_ITEM_BIAS);
- get_gui_callback (XVECTOR_DATA (XCDR (data)) [w_param - ID_ITEM_BIAS],
+ get_gui_callback (XVECTOR_DATA (XCAR (XCDR (data)))
+ [w_param - ID_ITEM_BIAS],
&fn, &arg);
mswindows_enqueue_misc_user_event (XCAR (data), fn, arg);
+ }
DestroyWindow (hwnd);
}
@@ -389,7 +411,7 @@
memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
translen =
- msw_translate_menu_or_dialog_item (trans,
+ mswindows_translate_menu_or_dialog_item (trans,
XSTRING_LENGTH (ctext),
2 * XSTRING_LENGTH (ctext) + 3,
&accel_unused,
@@ -408,27 +430,33 @@
data structure for the new dialog, which will contain callbacks
and the frame for these callbacks. This structure has to be
GC-protected. The data structure itself is a cons of frame object
- and a vector of callbacks; for the protection reasons it is put
- into a statically protected list. */
+ and a cons of a vector of callbacks and an opaque ptr holding the
+ dialog's hwnd; for the protection reasons it is put into a
+ statically protected list. */
{
- Lisp_Object frame, vector, dialog_data;
+ Lisp_Object frame, vector, opaque_ptr, dialog_data;
+ HWND dialog_hwnd;
int i;
XSETFRAME (frame, f);
vector = make_vector (Dynarr_length (dialog_items), Qunbound);
- dialog_data = Fcons (frame, vector);
+ opaque_ptr = make_opaque_ptr (0);
+ dialog_data = Fcons (frame, Fcons (vector, opaque_ptr));
for (i = 0; i < Dynarr_length (dialog_items); i++)
XVECTOR_DATA (vector) [i] =
XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
/* Woof! Everything is ready. Pop pop pop in now! */
- if (!CreateDialogIndirectParam (NULL,
+ dialog_hwnd =
+ CreateDialogIndirectParam (NULL,
(LPDLGTEMPLATE) Dynarr_atp (template, 0),
FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
- (LPARAM) LISP_TO_VOID (dialog_data)))
+ (LPARAM) LISP_TO_VOID (dialog_data));
+ if (!dialog_hwnd)
/* Something went wrong creating the dialog */
signal_simple_error ("System error creating dialog", desc);
+ set_opaque_ptr (opaque_ptr, (void *) dialog_hwnd);
Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
}
Index: src/eval.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.27.2.21
diff -u -w -r1.27.2.21 eval.c
--- eval.c 2000/03/13 07:27:53 1.27.2.21
+++ eval.c 2000/03/20 12:16:18
@@ -1,6 +1,7 @@
/* Evaluator for XEmacs Lisp interpreter.
Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc.
Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 2000 Ben Wing.
This file is part of XEmacs.
@@ -29,6 +30,7 @@
#include "bytecode.h"
#include "buffer.h"
#include "console.h"
+#include "lstream.h"
#include "opaque.h"
#ifdef ERROR_CHECK_GC
@@ -37,6 +39,56 @@
#define always_gc 0
#endif
+/* Note that there are five separate lists used to maintain state in
+ the evaluator. All of them conceptually are stacks (last-in,
+ first-out). All non-local exits happen ultimately through the
+ catch/throw mechanism, which uses one of the five lists (the
+ catchtag list) and records the current state of the others in each
+ frame of the list (some other information is recorded and restored
+ as well, such as the current eval depth), so that all the state of
+ the evaluator is restored properly when a non-local exit occurs.
+ (Note that the current state of the condition-handler list is not
+ recorded in the catchtag list. Instead, when a condition-case or
+ call-with-condition-handler is set up, it installs an
+ unwind-protect on the specbind list to restore the appropriate
+ setting for the condition-handler list. During the course of
+ handling the non-local exit, all entries on the specbind list that
+ are past the location stored in the catch frame are "unwound"
+ (i.e. variable bindings are restored and unwind-protects are
+ executed), so the condition-handler list gets reset properly.
+
+ The five lists are
+
+ 1. The backtrace list, which is chained through `struct backtrace's
+ declared in the stack frames of various primitives, and keeps
+ track of all Lisp function call entries and exits.
+ 2. The catchtag list, which is chained through `struct catchtag's
+ declared in the stack frames of internal_catch and condition_case_1,
+ and keeps track of information needed to reset the internal state
+ of the evaluator to the state that was current when the catch or
+ condition-case were established, in the event of a non-local exit.
+ 3. The condition-handler list, which is a simple Lisp list with new
+ entries consed onto the front of the list. It records condition-cases
+ and call-with-condition-handlers established either from C or from
+ Lisp. Unlike with the other lists (but similar to everything else
+ of a similar nature in the rest of the C and Lisp code), it takes care
+ of restoring itself appropriately in the event of a non-local exit
+ through the use of the unwind-protect mechanism.
+ 4. The specbind list, which is a contiguous array of `struct specbinding's,
+ expanded as necessary using realloc(). It holds dynamic variable
+ bindings (the only kind we currently have in ELisp) and unwind-protects.
+ 5. The GCPRO list, which is chained through `struct gcpro's declared in
+ the stack frames of any functions that need to GC-protect Lisp_Objects
+ declared on the stack. This is one of the most fragile areas of the
+ entire scheme -- you must not forget to UNGCPRO at the end of your
+ function, you must make sure you GCPRO in many circumstances you don't
+ think you have to, etc. See the internals manual for more information
+ about this.
+
+ --ben
+*/
+
+
struct backtrace *backtrace_list;
/* Note: you must always fill in all of the fields in a backtrace structure
@@ -71,6 +123,7 @@
/* If subrs take more than 8 arguments, more cases need to be added
to this switch. (But wait - don't do it - if you really need
a SUBR with more than 8 arguments, use max_args == MANY.
+ Or better, considering using a property list as one of your args.
See the DEFUN macro in lisp.h) */
#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \
void (*PF_fn)(void) = (void (*)(void)) fn; \
@@ -94,15 +147,22 @@
/* This is the list of current catches (and also condition-cases).
- This is a stack: the most recent catch is at the head of the
- list. Catches are created by declaring a 'struct catchtag'
- locally, filling the .TAG field in with the tag, and doing
- a setjmp() on .JMP. Fthrow() will store the value passed
- to it in .VAL and longjmp() back to .JMP, back to the function
- that established the catch. This will always be either
- internal_catch() (catches established internally or through
- `catch') or condition_case_1 (condition-cases established
- internally or through `condition-case').
+ This is a stack: the most recent catch is at the head of the list.
+ The list is threaded through the stack frames of the C functions
+ that set up the catches; this is similar to the way the GCPRO list
+ is handled, but different from the condition-handler list (which is
+ a simple Lisp list) and the specbind stack, which is a contiguous
+ array of `struct specbinding's, grown (using realloc()) as
+ necessary. (Note that all four of these lists behave as a stacks.)
+
+ Catches are created by declaring a 'struct catchtag' locally,
+ filling the .TAG field in with the tag, and doing a setjmp() on
+ .JMP. Fthrow() will store the value passed to it in .VAL and
+ longjmp() back to .JMP, back to the function that established the
+ catch. This will always be either internal_catch() (catches
+ established internally or through `catch') or condition_case_1
+ (condition-cases established internally or through
+ `condition-case').
The catchtag also records the current position in the
call stack (stored in BACKTRACE_LIST), the current position
@@ -114,6 +174,10 @@
struct catchtag *catchlist;
+/* A special tag that can be used internally from C code to catch
+ every attempt to throw past this level. */
+Lisp_Object Vcatch_everything_tag;
+
Lisp_Object Qautoload, Qmacro, Qexit;
Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
Lisp_Object Vquit_flag, Vinhibit_quit;
@@ -225,48 +289,64 @@
/* Function to call to invoke the debugger */
Lisp_Object Vdebugger;
-/* Chain of condition handlers currently in effect.
- The elements of this chain are contained in the stack frames
- of Fcondition_case and internal_condition_case.
- When an error is signaled (by calling Fsignal, below),
- this chain is searched for an element that applies.
+/* List of condition handlers currently in effect.
+ The elements of this lists were at one point in the past
+ threaded through the stack frames of Fcondition_case and
+ related functions, but now are stored separately in a normal
+ stack. When an error is signaled (by calling Fsignal, below),
+ this list is searched for an element that applies.
Each element of this list is one of the following:
- A list of a handler function and possibly args to pass to
- the function. This is a handler established with
- `call-with-condition-handler' (q.v.).
-
- A list whose car is Qunbound and whose cdr is Qt.
- This is a special condition-case handler established
- by C code with condition_case_1(). All errors are
- trapped; the debugger is not invoked even if
- `debug-on-error' was set.
+ -- A list of a handler function and possibly args to pass to the
+ function. This is a handler established with the Lisp primitive
+ `call-with-condition-handler' or related C function
+ call_with_condition_handler():
+
+ If the handler function is an opaque ptr object, it is a handler
+ that was established in C using call_with_condition_handler(),
+ and the contents of the object are a function pointer which takes
+ three arguments, the signal name and signal data (same arguments
+ passed to `signal') and a third Lisp_Object argument, specified
+ in the call to call_with_condition_handler() and stored as the
+ second element of the list containing the handler functionl.
+
+ If the handler function is a regular Lisp_Object, it is a handler
+ that was established using `call-with-condition-handler'.
+ Currently there are no more arguments in the list containing the
+ handler function, and only one argument is passed to the handler
+ function: a cons of the signal name and signal data arguments
+ passed to `signal'.
+
+ -- A list whose car is Qunbound and whose cdr is Qt. This is a
+ special condition-case handler established by C code with
+ condition_case_1(). All errors are trapped; the debugger is not
+ invoked even if `debug-on-error' was set.
+
+ -- A list whose car is Qunbound and whose cdr is Qerror. This is a
+ special condition-case handler established by C code with
+ condition_case_1(). It is like Qt except that the debugger is
+ invoked normally if it is called for.
+
+ -- A list whose car is Qunbound and whose cdr is a list of lists
+ (CONDITION-NAME BODY ...) exactly as in `condition-case'. This is
+ a normal `condition-case' handler.
+
+ Note that in all cases *except* the first, there is a corresponding
+ catch, whose TAG is the value of Vcondition_handlers just after the
+ handler data just described is pushed onto it. The reason is that
+ `condition-case' handlers need to throw back to the place where the
+ handler was installed before invoking it, while
+ `call-with-condition-handler' handlers are invoked in the
+ environment that `signal' was invoked in. */
- A list whose car is Qunbound and whose cdr is Qerror.
- This is a special condition-case handler established
- by C code with condition_case_1(). It is like Qt
- except that the debugger is invoked normally if it is
- called for.
-
- A list whose car is Qunbound and whose cdr is a list
- of lists (CONDITION-NAME BODY ...) exactly as in
- `condition-case'. This is a normal `condition-case'
- handler.
-
- Note that in all cases *except* the first, there is a
- corresponding catch, whose TAG is the value of
- Vcondition_handlers just after the handler data just
- described is pushed onto it. The reason is that
- `condition-case' handlers need to throw back to the
- place where the handler was installed before invoking
- it, while `call-with-condition-handler' handlers are
- invoked in the environment that `signal' was invoked
- in.
-*/
-static Lisp_Object Vcondition_handlers;
+static Lisp_Object Vcondition_handlers;
+/* I think we should keep this enabled all the time, not just when
+ error checking is enabled, because if one of these puppies pops up,
+ it will trash the stack if not caught, making it that much harder to
+ debug. It doesn't cause speed loss. */
#define DEFEND_AGAINST_THROW_RECURSION
#ifdef DEFEND_AGAINST_THROW_RECURSION
@@ -274,10 +354,6 @@
static int throw_level;
#endif
-#ifdef ERROR_CHECK_TYPECHECK
-void check_error_state_sanity (void);
-#endif
-
/************************************************************************/
/* The subr object type */
@@ -393,7 +469,7 @@
record_unwind_protect (restore_entering_debugger,
(entering_debugger ? Qt : Qnil));
entering_debugger = 1;
- val = internal_catch (Qdebugger, call_debugger_259, arg, &threw);
+ val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0);
return unbind_to (speccount, ((threw)
? Qunbound /* Not returning a value */
@@ -544,13 +620,28 @@
int *stack_trace_displayed,
int *debugger_entered)
{
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
/* This function can GC */
+#else /* reality check */
+ /* This function cannot GC because it inhibits GC during its operation */
+#endif
+
Lisp_Object val = Qunbound;
Lisp_Object all_handlers = Vcondition_handlers;
Lisp_Object temp_data = Qnil;
- int speccount = specpdl_depth();
+ int outer_speccount = specpdl_depth();
+ int speccount;
+
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
struct gcpro gcpro1, gcpro2;
GCPRO2 (all_handlers, temp_data);
+#else
+ record_unwind_protect (restore_gc_inhibit,
+ make_int (gc_currently_forbidden));
+ gc_currently_forbidden = 1;
+#endif
+
+ speccount = specpdl_depth();
Vcondition_handlers = active_handlers;
@@ -586,6 +677,7 @@
specbind (Qstack_trace_on_signal, Qnil);
val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
+ unbind_to (speccount, Qnil);
*debugger_entered = 1;
}
@@ -620,9 +712,11 @@
*debugger_entered = 1;
}
+#ifdef PIGS_FLY_AND_ALL_C_CODE_CAN_HANDLE_GC_OCCURRING_ALMOST_ANYWHERE
UNGCPRO;
+#endif
Vcondition_handlers = all_handlers;
- return unbind_to (speccount, val);
+ return unbind_to (outer_speccount, val);
}
@@ -1267,7 +1361,7 @@
/* This function can GC */
Lisp_Object tag = Feval (XCAR (args));
Lisp_Object body = XCDR (args);
- return internal_catch (tag, Fprogn, body, 0);
+ return internal_catch (tag, Fprogn, body, 0, 0);
}
/* Set up a catch, then call C function FUNC on argument ARG.
@@ -1278,7 +1372,8 @@
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object arg),
Lisp_Object arg,
- int * volatile threw)
+ int * volatile threw,
+ Lisp_Object * volatile thrown_tag)
{
/* This structure is made part of the chain `catchlist'. */
struct catchtag c;
@@ -1286,6 +1381,7 @@
/* Fill in the components of c, and put it on the list. */
c.next = catchlist;
c.tag = tag;
+ c.actual_tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
#if 0 /* FSFmacs */
@@ -1305,13 +1401,15 @@
{
/* Throw works by a longjmp that comes right here. */
if (threw) *threw = 1;
+ if (thrown_tag) *thrown_tag = c.actual_tag;
return c.val;
}
c.val = (*func) (arg);
if (threw) *threw = 0;
+ if (thrown_tag) *thrown_tag = Qnil;
catchlist = c.next;
-#ifdef ERROR_CHECK_TYPECHECK
- check_error_state_sanity ();
+#ifdef ERROR_CHECK_CATCH
+ check_catchlist_sanity ();
#endif
return c.val;
}
@@ -1334,7 +1432,7 @@
This is used for correct unwinding in Fthrow and Fsignal. */
static void
-unwind_to_catch (struct catchtag *c, Lisp_Object val)
+unwind_to_catch (struct catchtag *c, Lisp_Object val, Lisp_Object tag)
{
#if 0 /* FSFmacs */
/* #### */
@@ -1352,6 +1450,7 @@
(Can't overwrite tag slot because an unwind-protect may
want to throw to this same tag, which isn't yet invalid.) */
c->val = val;
+ c->actual_tag = tag;
#if 0 /* FSFmacs */
/* Restore the polling-suppression count. */
@@ -1369,8 +1468,8 @@
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
-#ifdef ERROR_CHECK_TYPECHECK
- check_error_state_sanity ();
+#ifdef ERROR_CHECK_CATCH
+ check_catchlist_sanity ();
#endif
}
while (! last_time);
@@ -1378,8 +1477,8 @@
/* Unwind the specpdl stack */
unbind_to (c->pdlcount, Qnil);
catchlist = c->next;
-#ifdef ERROR_CHECK_TYPECHECK
- check_error_state_sanity ();
+#ifdef ERROR_CHECK_CATCH
+ check_catchlist_sanity ();
#endif
#endif
@@ -1416,8 +1515,10 @@
'top-level catch and the catch-all error handler are
established at the same time, in initial_command_loop/
top_level_1.
+
+ [[#### Fix this horrifitude!]]
- #### Fix this horrifitude!
+ I don't think this is horrifitude, just defensive programming. --ben
*/
while (1)
@@ -1429,8 +1530,8 @@
#endif
for (c = catchlist; c; c = c->next)
{
- if (EQ (c->tag, tag))
- unwind_to_catch (c, val);
+ if (EQ (c->tag, tag) || EQ (c->tag, Vcatch_everything_tag))
+ unwind_to_catch (c, val, tag);
}
if (!bomb_out_p)
tag = Fsignal (Qno_catch, list2 (tag, val));
@@ -1500,10 +1601,14 @@
Lisp_Cons *victim;
/* ((handler-fun . handler-args) ... other handlers) */
Lisp_Object tem = XCAR (loser);
+ int first = 1;
while (CONSP (tem))
{
victim = XCONS (tem);
+ if (first && OPAQUE_PTRP (victim->car))
+ free_opaque_ptr (victim->car);
+ first = 0;
tem = victim->cdr;
free_cons (victim);
}
@@ -1607,6 +1712,7 @@
Vcondition_handlers);
#endif
c.val = Qnil;
+ c.actual_tag = Qnil;
c.backlist = backtrace_list;
#if 0 /* FSFmacs */
/* #### */
@@ -1650,8 +1756,8 @@
have this code here, and it doesn't cost anything, so I'm leaving it.*/
UNGCPRO;
catchlist = c.next;
-#ifdef ERROR_CHECK_TYPECHECK
- check_error_state_sanity ();
+#ifdef ERROR_CHECK_CATCH
+ check_catchlist_sanity ();
#endif
Vcondition_handlers = XCDR (c.tag);
@@ -1793,10 +1899,12 @@
int speccount = specpdl_depth();
Lisp_Object tem;
- /* #### If there were a way to check that args[0] were a function
- which accepted one arg, that should be done here ... */
+ tem = Ffunction_max_args (args[0]);
+ if (! (XINT (Ffunction_min_args (args[0])) <= 1
+ && (NILP (tem) || 1 <= XINT (tem))))
+ signal_simple_error ("Must be function of one argument", args[0]);
- /* (handler-fun . handler-args) */
+ /* (handler-fun . handler-args) but currently there are no handler-args */
tem = noseeum_cons (list1 (args[0]), Vcondition_handlers);
record_unwind_protect (condition_bind_unwind, tem);
Vcondition_handlers = tem;
@@ -1805,6 +1913,40 @@
return unbind_to (speccount, Ffuncall (nargs - 1, args + 1));
}
+/* This is the C version of the above function. It calls FUN, passing it
+ ARG, first setting up HANDLER to catch signals in the environment in
+ which they were signalled. (HANDLER is only invoked if there was no
+ handler (either from condition-case or call-with-condition-handler) set
+ later on that handled the signal; therefore, this is a real error.
+
+ HANDLER is invoked with three arguments: the ERROR-SYMBOL and DATA as
+ passed to `signal', and HANDLER_ARG. Originally I made HANDLER_ARG and
+ ARG be void * to facilitate passing structures, but I changed to
+ Lisp_Objects because all the other C interfaces to catch/condition-case/etc.
+ take Lisp_Objects, and it is easy enough to use make_opaque_ptr() et al.
+ to convert between Lisp_Objects and structure pointers. */
+
+Lisp_Object
+call_with_condition_handler (Lisp_Object (*handler) (Lisp_Object, Lisp_Object,
+ Lisp_Object),
+ Lisp_Object handler_arg,
+ Lisp_Object (*fun) (Lisp_Object),
+ Lisp_Object arg)
+{
+ /* This function can GC */
+ int speccount = specpdl_depth();
+ Lisp_Object tem;
+
+ /* ((handler-fun . (handler-arg . nil)) ... ) */
+ tem = noseeum_cons (noseeum_cons (make_opaque_ptr (handler),
+ noseeum_cons (handler_arg, Qnil)),
+ Vcondition_handlers);
+ record_unwind_protect (condition_bind_unwind, tem);
+ Vcondition_handlers = tem;
+
+ return unbind_to (speccount, (*fun) (arg));
+}
+
static int
condition_type_p (Lisp_Object type, Lisp_Object conditions)
{
@@ -1876,8 +2018,16 @@
}
if (gc_in_progress || in_display)
- /* This is one of many reasons why you can't run lisp code from redisplay.
- There is no sensible way to handle errors there. */
+ /* [[This is one of many reasons why you can't run lisp code from
+ redisplay. There is no sensible way to handle errors there.]]
+
+ The above comment is not correct.
+
+ Inhibit GC until the redisplay code is careful enough to properly
+ GCPRO their structures;
+
+ Surround all calls to Lisp code with error-trapping wrappers that
+ catch all errors. --ben */
abort ();
conditions = Fget (sig, Qerror_conditions, Qnil);
@@ -1906,6 +2056,28 @@
if (!UNBOUNDP (tem))
RETURN_NUNGCPRO (return_from_signal (tem));
+ if (OPAQUE_PTRP (handler_fun))
+ {
+ if (NILP (handler_data))
+ {
+ Lisp_Object (*hfun) (Lisp_Object, Lisp_Object) =
+ (Lisp_Object (*) (Lisp_Object, Lisp_Object))
+ (get_opaque_ptr (handler_fun));
+
+ tem = (*hfun) (sig, data);
+ }
+ else
+ {
+ Lisp_Object (*hfun) (Lisp_Object, Lisp_Object, Lisp_Object) =
+ (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object))
+ (get_opaque_ptr (handler_fun));
+
+ assert (NILP (XCDR (handler_data)));
+ tem = (*hfun) (sig, data, XCAR (handler_data));
+ }
+ }
+ else
+ {
tem = Fcons (sig, data);
if (NILP (handler_data))
tem = call1 (handler_fun, tem);
@@ -1923,6 +2095,7 @@
tem = Fapply (3, args);
NNUNGCPRO;
}
+ }
NUNGCPRO;
#if 0
if (!EQ (tem, Qsignal))
@@ -1995,8 +2168,10 @@
there is no 'top-level catch. (That's why the
"bomb-out" hack was added.)
- #### Fix this horrifitude!
- */
+ [[#### Fix this horrifitude!]]
+
+ I don't think this is horrifitude, but just defensive coding. --ben */
+
signal_call_debugger (conditions, sig, data, Qnil, 0,
&stack_trace_displayed,
&debugger_entered);
@@ -2056,9 +2231,10 @@
for (;;)
Fsignal (sig, data);
}
-#ifdef ERROR_CHECK_TYPECHECK
+#ifdef ERROR_CHECK_CATCH
+
void
-check_error_state_sanity (void)
+check_catchlist_sanity (void)
{
struct catchtag *c;
int found_error_tag = 0;
@@ -2074,6 +2250,12 @@
assert (found_error_tag || NILP (Vcurrent_error_state));
}
+
+void
+check_specbind_stack_sanity (void)
+{
+}
+
#endif
static Lisp_Object
@@ -2199,7 +2381,7 @@
kludgy_args[2] = no_error;
the_retval = internal_catch (Qunbound_suspended_errors_tag,
call_with_suspended_errors_1,
- opaque1, &threw);
+ opaque1, &threw, 0);
free_opaque_ptr (opaque1);
free_opaque_ptr (opaque2);
UNGCPRO;
@@ -3385,9 +3567,12 @@
}
DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /*
-Return the number of arguments a function may be called with.
+Return the minimum number of arguments a function may be called with.
The function may be any form that can be passed to `funcall',
any special form, or any macro.
+
+To check if a function can be called with a specified number of
+arguments, use `function-allows-args'.
*/
(function))
{
@@ -3395,11 +3580,14 @@
}
DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /*
-Return the number of arguments a function may be called with.
+Return the maximum number of arguments a function may be called with.
The function may be any form that can be passed to `funcall',
any special form, or any macro.
If the function takes an arbitrary number of arguments or is
a built-in special form, nil is returned.
+
+To check if a function can be called with a specified number of
+arguments, use `function-allows-args'.
*/
(function))
{
@@ -4157,309 +4345,438 @@
return value.
*/
-/* #### This stuff needs to catch throws as well. We need to
- improve internal_catch() so it can take a "catch anything"
- argument similar to Qt or Qerror for condition_case_1(). */
-static Lisp_Object
-caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
-{
- if (!NILP (errordata))
+struct call_trapping_problems
{
- Lisp_Object args[2];
+ Lisp_Object catchtag;
+ Lisp_Object error_conditions;
+ Lisp_Object data;
+ Lisp_Object backtrace;
+
+ const char *warning_string;
+ Lisp_Object (*fun) (void *);
+ void *arg;
+};
- if (!NILP (arg))
+static Lisp_Object
+flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
+ Lisp_Object opaque)
{
- char *str = (char *) get_opaque_ptr (arg);
- args[0] = build_string (str);
- }
- else
- args[0] = build_string ("error");
+ struct call_trapping_problems *p =
+ (struct call_trapping_problems *) get_opaque_ptr (opaque);
+ Lisp_Object args[3];
+ struct gcpro gcpro1;
+ Lisp_Object lstream = Qnil;
+ Lisp_Object errstr;
+ int speccount = specpdl_depth ();
+
+ /* We're no longer protected against errors or quit here, so at least let's
+ temporarily inhibit quit. We definitely do not want to inhibit quit
+ during the calling of the function itself!!!!!!!!!!! */
+
+ specbind (Qinhibit_quit, Qt);
+
+ GCPRO1 (lstream);
+ lstream = make_resizing_buffer_output_stream ();
+ Fbacktrace (lstream, Qt);
+ p->backtrace =
+ build_string (resizing_buffer_stream_ptr (XLSTREAM (lstream)));
+ Lstream_delete (XLSTREAM (lstream));
+ UNGCPRO;
+
+ args[0] = build_string (p->warning_string ? p->warning_string :
"error");
+ args[1] = error_conditions;
+ args[2] = data;
+ args[3] = p->backtrace;
+
+ GCPRO1_ARRAY (args, 4);
/* #### This should call
- (with-output-to-string (display-error errordata))
+ (with-output-to-string (display-error (cons error_conditions data))
but that stuff is all in Lisp currently. */
- args[1] = errordata;
- warn_when_safe_lispobj
- (Qerror, Qwarning,
- emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
- Qnil, -1, 2, args));
- }
- return Qunbound;
-}
+ errstr = emacs_doprnt_string_lisp ((const Bufbyte *) "%s: (%s %s)\n\nBacktrace
follows:\n\n%s",
+ Qnil, -1, 4, args);
+ UNGCPRO;
-static Lisp_Object
-allow_quit_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
-{
- if (CONSP (errordata) && EQ (XCAR (errordata), Qquit))
- return Fsignal (Qquit, XCDR (errordata));
- return caught_a_squirmer (errordata, arg);
-}
+ warn_when_safe_lispobj (Qerror, Qwarning, errstr);
-static Lisp_Object
-safe_run_hook_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
-{
- Lisp_Object hook = Fcar (arg);
- arg = Fcdr (arg);
- /* Clear out the hook. */
- Fset (hook, Qnil);
- return caught_a_squirmer (errordata, arg);
+ p->error_conditions = error_conditions;
+ p->data = data;
+
+ unbind_to (speccount, Qnil);
+ Fthrow (p->catchtag, Qnil);
+ return Qnil; /* not reached */
}
static Lisp_Object
-allow_quit_safe_run_hook_caught_a_squirmer (Lisp_Object errordata,
- Lisp_Object arg)
+call_trapping_problems_2 (Lisp_Object opaque)
{
- Lisp_Object hook = Fcar (arg);
- arg = Fcdr (arg);
- if (!CONSP (errordata) || !EQ (XCAR (errordata), Qquit))
- /* Clear out the hook. */
- Fset (hook, Qnil);
- return allow_quit_caught_a_squirmer (errordata, arg);
+ struct call_trapping_problems *p =
+ (struct call_trapping_problems *) get_opaque_ptr (opaque);
+
+ return (p->fun) (p->arg);
}
static Lisp_Object
-catch_them_squirmers_eval_in_buffer (Lisp_Object cons)
+call_trapping_problems_1 (Lisp_Object opaque)
{
- return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons));
+ struct call_trapping_problems *p =
+ (struct call_trapping_problems *) get_opaque_ptr (opaque);
+ return call_with_condition_handler (flagged_a_squirmer, opaque,
+ call_trapping_problems_2, opaque);
}
+/* This is equivalent to (*fun) (arg), except that when an error
+ occurs, the error is caught, and a warning is issued, specifying
+ the specific error that occurred and a backtrace.
+
+ If FLAGS contains INHIBIT_THROWS, all attempts to `throw' out of
+ the function being called are trapped, and a warning issued.
+
+ Note: If you use INHIBIT_THROWS, you are *guaranteed* that there will
+ be no non-local exits out of this function.
+
+ If FLAGS contains INHIBIT_QUIT, QUIT using C-g is inhibited.
+ (This is *rarely* a good idea. QUIT is automatically caught, anyway,
+ and treated as an error; you can check for this using
+ EQ (problems->error_conditions, Qquit).
+
+ If FLAGS contains INHIBIT_GC, garbage collection is inhibited. This is
+ useful for Lisp called within redisplay or inside of the QUIT macro
+ (where GC is generally not expected), for example.
+
+ If PROBLEM is non-zero, it should be a pointer to a structure into which
+ exact information about any occurring problems (either an error or an
+ attempted throw past this boundary).
+
+ If a problem occurred and aborted operation (error, quit, or invalid throw),
+ Qunbound is returned. Otherwise the return value from the call to
+ (*fun) (arg) is returned.
+ */
+
Lisp_Object
-eval_in_buffer_trapping_errors (const char *warning_string,
- struct buffer *buf, Lisp_Object form)
+call_trapping_problems (const char *warning_string,
+ Lisp_Object (*fun) (void *),
+ void *arg,
+ int flags,
+ struct call_trapping_problems_result *problem)
{
int speccount = specpdl_depth();
- Lisp_Object tem;
- Lisp_Object buffer;
- Lisp_Object cons;
- Lisp_Object opaque;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct call_trapping_problems package;
+ Lisp_Object opaque, thrown_tag, tem;
+ int thrown;
+
+ package.warning_string = warning_string;
+ package.fun = fun;
+ package.arg = arg;
+ package.catchtag =
+ flags & INHIBIT_THROWS ? Vcatch_everything_tag : make_opaque_ptr (0);
+ package.error_conditions = Qnil;
+ package.data = Qnil;
+ package.backtrace = Qnil;
- XSETBUFFER (buffer, buf);
+ if (flags & INHIBIT_QUIT)
+ specbind (Qinhibit_quit, Qt);
+ if (flags & INHIBIT_GC)
+ {
+ record_unwind_protect (restore_gc_inhibit,
+ make_int (gc_currently_forbidden));
+ gc_currently_forbidden = 1;
+ }
+ opaque = make_opaque_ptr (&package);
+
+ GCPRO5 (package.catchtag, package.error_conditions, package.data,
+ package.backtrace, opaque);
+ tem = internal_catch (package.catchtag, call_trapping_problems_1, opaque,
+ &thrown, &thrown_tag);
+
+ if (thrown && !EQ (thrown_tag, package.catchtag))
+ {
+ Lisp_Object args[3];
+ struct gcpro ngcpro1;
+ Lisp_Object errstr;
+
+ if (!(flags & INHIBIT_QUIT))
+ /* We're no longer protected against errors or quit here, so at
+ least let's temporarily inhibit quit. */
specbind (Qinhibit_quit, Qt);
- /* gc_currently_forbidden = 1; Currently no reason to do this; */
+ args[0] = build_string (warning_string ? warning_string : "error");
+ args[1] = thrown_tag;
+ args[2] = tem;
+ NGCPRO1_ARRAY (args, 3);
+ errstr = emacs_doprnt_string_lisp ((const Bufbyte *) "%s: Attempt to throw
outside of function to catch `%s' with value `%s'",
+ Qnil, -1, 3, args);
- cons = noseeum_cons (buffer, form);
- opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
- GCPRO2 (cons, opaque);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_eval_in_buffer, cons,
- caught_a_squirmer, opaque);
- free_cons (XCONS (cons));
- if (OPAQUE_PTRP (opaque))
+ warn_when_safe_lispobj (Qerror, Qwarning, errstr);
+ NUNGCPRO;
+ }
+
+ if (problem)
+ {
+ if (!thrown)
+ {
+ problem->caught_error = 0;
+ problem->caught_throw = 0;
+ problem->error_conditions = Qnil;
+ problem->data = Qnil;
+ problem->backtrace = Qnil;
+ problem->thrown_tag = Qnil;
+ problem->thrown_value = Qnil;
+ }
+ else if (EQ (thrown_tag, package.catchtag))
+ {
+ problem->caught_error = 1;
+ problem->caught_throw = 0;
+ problem->error_conditions = package.error_conditions;
+ problem->data = package.data;
+ problem->backtrace = package.backtrace;
+ problem->thrown_tag = Qnil;
+ problem->thrown_value = Qnil;
+ }
+ else
+ {
+ problem->caught_error = 0;
+ problem->caught_throw = 1;
+ problem->error_conditions = Qnil;
+ problem->data = Qnil;
+ problem->backtrace = Qnil;
+ problem->thrown_tag = thrown_tag;
+ problem->thrown_value = tem;
+ }
+ }
+
+ if (!EQ (package.catchtag, Vcatch_everything_tag))
+ free_opaque_ptr (package.catchtag);
+
free_opaque_ptr (opaque);
- UNGCPRO;
- /* gc_currently_forbidden = 0; */
- return unbind_to (speccount, tem);
+ unbind_to (speccount, Qnil);
+ RETURN_UNGCPRO (thrown ? Qunbound : tem);
}
+struct calln_trapping_errors
+{
+ int nargs;
+ Lisp_Object *args;
+};
+
static Lisp_Object
-catch_them_squirmers_run_hook (Lisp_Object hook_symbol)
+calln_trapping_errors_1 (void *puta)
{
- /* This function can GC */
- run_hook (hook_symbol);
- return Qnil;
+ struct calln_trapping_errors *p = (struct calln_trapping_errors *) puta;
+
+ return Ffuncall (p->nargs, p->args);
}
-Lisp_Object
-run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol)
+static Lisp_Object
+calln_trapping_errors (const char *warning_string, int nargs,
+ Lisp_Object *args, int flags)
{
- int speccount;
- Lisp_Object tem;
- Lisp_Object opaque;
+ struct calln_trapping_errors foo;
struct gcpro gcpro1;
- if (!initialized || preparing_for_armageddon)
- return Qnil;
- tem = find_symbol_value (hook_symbol);
+ if (SYMBOLP (args[0]))
+ {
+ Lisp_Object tem = XSYMBOL (args[0])->function;
if (NILP (tem) || UNBOUNDP (tem))
return Qnil;
-
- speccount = specpdl_depth();
- specbind (Qinhibit_quit, Qt);
+ }
- opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
- GCPRO1 (opaque);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_run_hook, hook_symbol,
- caught_a_squirmer, opaque);
- if (OPAQUE_PTRP (opaque))
- free_opaque_ptr (opaque);
- UNGCPRO;
+ foo.nargs = nargs;
+ foo.args = args;
- return unbind_to (speccount, tem);
+ GCPRO1_ARRAY (args, nargs);
+ RETURN_UNGCPRO (call_trapping_problems (warning_string,
+ calln_trapping_errors_1,
+ &foo, flags, 0));
}
-/* Same as run_hook_trapping_errors() but also set the hook to nil
- if an error occurs. */
+Lisp_Object
+call0_trapping_errors (const char *warning_string, Lisp_Object function,
+ int flags)
+{
+ return calln_trapping_errors (warning_string, 1, &function, flags);
+}
Lisp_Object
-safe_run_hook_trapping_errors (const char *warning_string,
- Lisp_Object hook_symbol,
- int allow_quit)
+call1_trapping_errors (const char *warning_string, Lisp_Object function,
+ Lisp_Object object, int flags)
{
- int speccount = specpdl_depth();
- Lisp_Object tem;
- Lisp_Object cons = Qnil;
- struct gcpro gcpro1;
+ Lisp_Object args[2];
- if (!initialized || preparing_for_armageddon)
- return Qnil;
- tem = find_symbol_value (hook_symbol);
- if (NILP (tem) || UNBOUNDP (tem))
- return Qnil;
+ args[0] = function;
+ args[1] = object;
- if (!allow_quit)
- specbind (Qinhibit_quit, Qt);
+ return calln_trapping_errors (warning_string, 2, args, flags);
+}
- cons = noseeum_cons (hook_symbol,
- warning_string ? make_opaque_ptr ((void *)warning_string)
- : Qnil);
- GCPRO1 (cons);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_run_hook,
- hook_symbol,
- allow_quit ?
- allow_quit_safe_run_hook_caught_a_squirmer :
- safe_run_hook_caught_a_squirmer,
- cons);
- if (OPAQUE_PTRP (XCDR (cons)))
- free_opaque_ptr (XCDR (cons));
- free_cons (XCONS (cons));
- UNGCPRO;
+Lisp_Object
+call2_trapping_errors (const char *warning_string, Lisp_Object function,
+ Lisp_Object object1, Lisp_Object object2,
+ int flags)
+{
+ Lisp_Object args[3];
+
+ args[0] = function;
+ args[1] = object1;
+ args[2] = object2;
- return unbind_to (speccount, tem);
+ return calln_trapping_errors (warning_string, 3, args, flags);
}
-static Lisp_Object
-catch_them_squirmers_call0 (Lisp_Object function)
+Lisp_Object
+call3_trapping_errors (const char *warning_string, Lisp_Object function,
+ Lisp_Object object1, Lisp_Object object2,
+ Lisp_Object object3, int flags)
{
- /* This function can GC */
- return call0 (function);
+ Lisp_Object args[4];
+
+ args[0] = function;
+ args[1] = object1;
+ args[2] = object2;
+ args[3] = object3;
+
+ return calln_trapping_errors (warning_string, 4, args, flags);
}
Lisp_Object
-call0_trapping_errors (const char *warning_string, Lisp_Object function)
+call4_trapping_errors (const char *warning_string, Lisp_Object function,
+ Lisp_Object object1, Lisp_Object object2,
+ Lisp_Object object3, Lisp_Object object4,
+ int flags)
{
- int speccount;
- Lisp_Object tem;
- Lisp_Object opaque = Qnil;
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object args[5];
- if (SYMBOLP (function))
- {
- tem = XSYMBOL (function)->function;
- if (NILP (tem) || UNBOUNDP (tem))
- return Qnil;
+ args[0] = function;
+ args[1] = object1;
+ args[2] = object2;
+ args[3] = object3;
+ args[4] = object4;
+
+ return calln_trapping_errors (warning_string, 5, args, flags);
}
- GCPRO2 (opaque, function);
- speccount = specpdl_depth();
- specbind (Qinhibit_quit, Qt);
- /* gc_currently_forbidden = 1; Currently no reason to do this; */
+Lisp_Object
+call5_trapping_errors (const char *warning_string, Lisp_Object function,
+ Lisp_Object object1, Lisp_Object object2,
+ Lisp_Object object3, Lisp_Object object4,
+ Lisp_Object object5, int flags)
+{
+ Lisp_Object args[6];
- opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_call0, function,
- caught_a_squirmer, opaque);
- if (OPAQUE_PTRP (opaque))
- free_opaque_ptr (opaque);
- UNGCPRO;
+ args[0] = function;
+ args[1] = object1;
+ args[2] = object2;
+ args[3] = object3;
+ args[4] = object4;
+ args[5] = object5;
- /* gc_currently_forbidden = 0; */
- return unbind_to (speccount, tem);
+ return calln_trapping_errors (warning_string, 6, args, flags);
}
-static Lisp_Object
-catch_them_squirmers_call1 (Lisp_Object cons)
+struct eval_in_buffer_trapping_errors
{
- /* This function can GC */
- return call1 (XCAR (cons), XCDR (cons));
-}
+ struct buffer *buf;
+ Lisp_Object form;
+};
+
static Lisp_Object
-catch_them_squirmers_call2 (Lisp_Object cons)
+eval_in_buffer_trapping_errors_1 (void *arg)
{
- /* This function can GC */
- return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons))));
+ struct eval_in_buffer_trapping_errors *p =
+ (struct eval_in_buffer_trapping_errors *) arg;
+
+ return eval_in_buffer (p->buf, p->form);
}
Lisp_Object
-call1_trapping_errors (const char *warning_string, Lisp_Object function,
- Lisp_Object object)
+eval_in_buffer_trapping_errors (const char *warning_string,
+ struct buffer *buf, Lisp_Object form,
+ int flags)
{
- int speccount = specpdl_depth();
- Lisp_Object tem;
- Lisp_Object cons = Qnil;
- Lisp_Object opaque = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct eval_in_buffer_trapping_errors p;
+ Lisp_Object buffer;
+ struct gcpro gcpro1, gcpro2;
- if (SYMBOLP (function))
+ XSETBUFFER (buffer, buf);
+ GCPRO2 (buffer, form);
+ p.buf = buf;
+ p.form = form;
+ RETURN_UNGCPRO (call_trapping_problems (warning_string,
+ eval_in_buffer_trapping_errors_1,
+ &p, flags, 0));
+}
+
+static Lisp_Object
+run_hook_trapping_errors_1 (void *puta)
{
- tem = XSYMBOL (function)->function;
- if (NILP (tem) || UNBOUNDP (tem))
+ Lisp_Object hook;
+ VOID_TO_LISP (hook, puta);
+
+ run_hook (hook);
return Qnil;
}
- GCPRO4 (cons, opaque, function, object);
-
- specbind (Qinhibit_quit, Qt);
- /* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* Run a hook, trapping all errors and generating appropriate
+ warnings, complete with full backtrace. Return Qunbound if
+ problems, normal result of run-hook otherwise. FLAGS is as
+ in call_trapping_problems().
- cons = noseeum_cons (function, object);
- opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_call1, cons,
- caught_a_squirmer, opaque);
- if (OPAQUE_PTRP (opaque))
- free_opaque_ptr (opaque);
- free_cons (XCONS (cons));
- UNGCPRO;
+ #### NOTE: The old version, when it didn't suppress quit entirely,
+ would resignal a quit if it was caught. I don't think that is
+ necessarily a good idea, but I am open to suggestions.
- /* gc_currently_forbidden = 0; */
- return unbind_to (speccount, tem);
-}
+ */
Lisp_Object
-call2_trapping_errors (const char *warning_string, Lisp_Object function,
- Lisp_Object object1, Lisp_Object object2)
+run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol,
+ int flags)
{
- int speccount = specpdl_depth();
Lisp_Object tem;
- Lisp_Object cons = Qnil;
- Lisp_Object opaque = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1;
- if (SYMBOLP (function))
- {
- tem = XSYMBOL (function)->function;
+ if (!initialized || preparing_for_armageddon)
+ return Qnil;
+ tem = find_symbol_value (hook_symbol);
if (NILP (tem) || UNBOUNDP (tem))
return Qnil;
+
+ GCPRO1 (hook_symbol);
+ RETURN_UNGCPRO (call_trapping_problems (warning_string,
+ run_hook_trapping_errors_1,
+ LISP_TO_VOID (hook_symbol),
+ flags, 0));
}
- GCPRO5 (cons, opaque, function, object1, object2);
- specbind (Qinhibit_quit, Qt);
- /* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* Same as run_hook_trapping_errors() but also set the hook to nil
+ if an error occurs (but not a quit). */
- cons = list3 (function, object1, object2);
- opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
- /* Qerror not Qt, so you can get a backtrace */
- tem = condition_case_1 (Qerror,
- catch_them_squirmers_call2, cons,
- caught_a_squirmer, opaque);
- if (OPAQUE_PTRP (opaque))
- free_opaque_ptr (opaque);
- free_list (cons);
- UNGCPRO;
+Lisp_Object
+safe_run_hook_trapping_errors (const char *warning_string,
+ Lisp_Object hook_symbol,
+ int flags)
+{
+ Lisp_Object tem;
+ struct gcpro gcpro1, gcpro2;
+ struct call_trapping_problems_result prob;
- /* gc_currently_forbidden = 0; */
- return unbind_to (speccount, tem);
+ if (!initialized || preparing_for_armageddon)
+ return Qnil;
+ tem = find_symbol_value (hook_symbol);
+ if (NILP (tem) || UNBOUNDP (tem))
+ return Qnil;
+
+ GCPRO2 (hook_symbol, tem);
+ tem = call_trapping_problems (warning_string,
+ run_hook_trapping_errors_1,
+ LISP_TO_VOID (hook_symbol), 1,
+ &prob);
+ if (prob.caught_throw || prob.caught_error && !EQ (prob.error_conditions,
+ Qquit))
+ Fset (hook_symbol, Qnil);
+ RETURN_UNGCPRO (tem);
}
@@ -4497,6 +4814,9 @@
}
XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size);
specpdl_ptr = specpdl + specpdl_depth();
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
@@ -4576,6 +4896,10 @@
specbind (Lisp_Object symbol, Lisp_Object value)
{
SPECBIND (symbol, value);
+
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
void
@@ -4608,6 +4932,10 @@
specpdl_depth_counter++;
Fset (symbol, value);
+
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
void
@@ -4620,6 +4948,9 @@
specpdl_ptr->old_value = arg;
specpdl_ptr++;
specpdl_depth_counter++;
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
extern int check_sigio (void);
@@ -4631,6 +4962,9 @@
unbind_to (int count, Lisp_Object value)
{
UNBIND_TO_GCPRO (count, value);
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
return value;
}
@@ -4641,13 +4975,13 @@
{
int quitf;
+ ++specpdl_ptr;
+ ++specpdl_depth_counter;
+
check_quit (); /* make Vquit_flag accurate */
quitf = !NILP (Vquit_flag);
Vquit_flag = Qnil;
- ++specpdl_ptr;
- ++specpdl_depth_counter;
-
while (specpdl_depth_counter != count)
{
--specpdl_ptr;
@@ -4689,6 +5023,9 @@
}
if (quitf)
Vquit_flag = Qt;
+#ifdef ERROR_CHECK_CATCH
+ check_specbind_stack_sanity ();
+#endif
}
@@ -5210,6 +5547,9 @@
If due to `eval' entry, one arg, t.
*/ );
Vdebugger = Qnil;
+
+ staticpro (&Vcatch_everything_tag);
+ Vcatch_everything_tag = make_opaque_ptr (0);
staticpro (&Vpending_warnings);
Vpending_warnings = Qnil;
Index: src/event-unixoid.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-unixoid.c,v
retrieving revision 1.9.2.4
diff -u -w -r1.9.2.4 event-unixoid.c
--- event-unixoid.c 2000/03/13 07:27:56 1.9.2.4
+++ event-unixoid.c 2000/03/20 12:16:18
@@ -176,34 +176,73 @@
static int
get_process_infd (Lisp_Process *p)
{
- Lisp_Object instr, outstr;
- get_process_streams (p, &instr, &outstr);
+ Lisp_Object instr, outstr, errstr;
+ get_process_streams (p, &instr, &outstr, &errstr);
assert (!NILP (instr));
return filedesc_stream_fd (XLSTREAM (instr));
}
-int
-event_stream_unixoid_select_process (Lisp_Process *proc)
+static int
+get_process_errfd (Lisp_Process *p)
{
- int infd = get_process_infd (proc);
+ Lisp_Object instr, outstr, errstr;
+ get_process_streams (p, &instr, &outstr, &errstr);
+ if (!NILP (errstr))
+ return filedesc_stream_fd (XLSTREAM (errstr));
+ else
+ return -1;
+}
- FD_SET (infd, &input_wait_mask);
- FD_SET (infd, &non_fake_input_wait_mask);
- FD_SET (infd, &process_only_mask);
- return infd;
+void
+event_stream_unixoid_select_process (Lisp_Process *proc, int doin, int doerr,
+ int *infd, int *errfd)
+{
+ if (doin)
+ {
+ *infd = get_process_infd (proc);
+ FD_SET (*infd, &input_wait_mask);
+ FD_SET (*infd, &non_fake_input_wait_mask);
+ FD_SET (*infd, &process_only_mask);
}
-int
-event_stream_unixoid_unselect_process (Lisp_Process *proc)
+ if (doerr)
{
- int infd = get_process_infd (proc);
+ *errfd = get_process_errfd (proc);
- FD_CLR (infd, &input_wait_mask);
- FD_CLR (infd, &non_fake_input_wait_mask);
- FD_CLR (infd, &process_only_mask);
- return infd;
+ if (*errfd >= 0)
+ {
+ FD_SET (*errfd, &input_wait_mask);
+ FD_SET (*errfd, &non_fake_input_wait_mask);
+ FD_SET (*errfd, &process_only_mask);
+ }
+ }
}
+void
+event_stream_unixoid_unselect_process (Lisp_Process *proc, int doin, int doerr,
+ int *infd, int *errfd)
+{
+ if (doin)
+ {
+ *infd = get_process_infd (proc);
+ FD_CLR (*infd, &input_wait_mask);
+ FD_CLR (*infd, &non_fake_input_wait_mask);
+ FD_CLR (*infd, &process_only_mask);
+ }
+
+ if (doerr)
+ {
+ *errfd = get_process_errfd (proc);
+
+ if (*errfd >= 0)
+ {
+ FD_CLR (*errfd, &input_wait_mask);
+ FD_CLR (*errfd, &non_fake_input_wait_mask);
+ FD_CLR (*errfd, &process_only_mask);
+ }
+ }
+}
+
int
poll_fds_for_input (SELECT_TYPE mask)
{
@@ -238,13 +277,16 @@
/* Unixoid (file descriptors based) process I/O streams routines */
/****************************************************************************/
-USID
-event_stream_unixoid_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream,
+void
+event_stream_unixoid_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)
{
- int infd, outfd;
+ int infd, outfd, errfd;
/* Decode inhandle and outhandle. Their meaning depends on
the process implementation being used. */
#if defined (HAVE_WIN32_PROCESSES)
@@ -253,8 +295,12 @@
{
infd = open_osfhandle ((HANDLE)inhandle, 0);
if (infd < 0)
- return USID_ERROR;
+ {
+ *in_usid = USID_ERROR;
+ *err_usid = USID_ERROR;
+ return;
}
+ }
else
infd = -1;
@@ -265,17 +311,37 @@
{
if (infd >= 0)
close (infd);
- return USID_ERROR;
+ *in_usid = USID_ERROR;
+ *err_usid = USID_ERROR;
+ return;
}
}
else
outfd = -1;
+ if (errhandle != (void *) -1 && (HANDLE)errthandle != INVALID_HANDLE_VALUE)
+ {
+ errfd = open_osfhandle ((HANDLE)outhandle, 0);
+ if (errfd < 0)
+ {
+ if (infd >= 0)
+ close (infd);
+ if (outfd >= 0)
+ close (outfd);
+ *in_usid = USID_ERROR;
+ *err_usid = USID_ERROR;
+ return;
+ }
+ }
+ else
+ errfd = -1;
+
flags = 0;
#elif defined (HAVE_UNIX_PROCESSES)
/* We are passed plain old file descs */
infd = (int)inhandle;
outfd = (int)outhandle;
+ errfd = (int)errhandle;
#else
# error Which processes do you have?
#endif
@@ -288,34 +354,49 @@
? make_filedesc_output_stream (outfd, 0, -1, LSTR_BLOCKED_OK)
: Qnil);
+ *errstream = (errfd >= 0
+ ? make_filedesc_input_stream (errfd, 0, -1, 0)
+ : Qnil);
+
+
#if defined(HAVE_UNIX_PROCESSES) && defined(HAVE_PTYS)
/* FLAGS is process->pty_flag for UNIX_PROCESSES */
if ((flags & STREAM_PTY_FLUSHING) && outfd >= 0)
{
Bufbyte eof_char = get_eof_char (outfd);
int pty_max_bytes = get_pty_max_bytes (outfd);
- filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes, eof_char);
+ filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes,
+ eof_char);
}
#endif
- return FD_TO_USID (infd);
+ *in_usid = FD_TO_USID (infd);
+ *err_usid = FD_TO_USID (errfd);
}
-USID
-event_stream_unixoid_delete_stream_pair (Lisp_Object instream,
- Lisp_Object outstream)
+void
+event_stream_unixoid_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid)
{
int in = (NILP(instream) ? -1
: filedesc_stream_fd (XLSTREAM (instream)));
int out = (NILP(outstream) ? -1
: filedesc_stream_fd (XLSTREAM (outstream)));
+ int err = (NILP(errstream) ? -1
+ : filedesc_stream_fd (XLSTREAM (errstream)));
if (in >= 0)
close (in);
if (out != in && out >= 0)
close (out);
+ if (err != in && err != out && err >= 0)
+ close (err);
- return FD_TO_USID (in);
+ *in_usid = FD_TO_USID (in);
+ *err_usid = FD_TO_USID (err);
}
Index: src/gpmevent.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/gpmevent.c,v
retrieving revision 1.5.2.7
diff -u -w -r1.5.2.7 gpmevent.c
--- gpmevent.c 2000/03/13 07:27:58 1.5.2.7
+++ gpmevent.c 2000/03/20 12:16:19
@@ -97,8 +97,8 @@
static int
get_process_infd (Lisp_Process *p)
{
- Lisp_Object instr, outstr;
- get_process_streams (p, &instr, &outstr);
+ Lisp_Object instr, outstr, errstr;
+ get_process_streams (p, &instr, &outstr, &errstr);
assert (!NILP (instr));
return filedesc_stream_fd (XLSTREAM (instr));
}
@@ -604,7 +604,8 @@
/* Is this really necessary? */
set_descriptor_non_blocking (gpm_fd);
store_gpm_state (gpm_fd);
- gpm_process = connect_to_file_descriptor (build_string (process_name), Qnil,
+ gpm_process = connect_to_file_descriptor (build_string
+ (process_name), Qnil,
make_int (gpm_fd),
make_int (gpm_fd));
@@ -613,7 +614,7 @@
rval = 0;
Fprocess_kill_without_query (gpm_process, Qnil);
XSETSUBR (gpm_filter, &SFreceive_gpm_event);
- set_process_filter (gpm_process, gpm_filter, 1);
+ set_process_filter (gpm_process, gpm_filter, 1, 0);
/* Keep track of the device for later */
/* Fput (gpm_process, intern ("gpm-device"), device); */
Index: src/menubar-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/menubar-msw.c,v
retrieving revision 1.16.2.10
diff -u -w -r1.16.2.10 menubar-msw.c
--- menubar-msw.c 2000/03/13 07:28:01 1.16.2.10
+++ menubar-msw.c 2000/03/20 12:16:19
@@ -126,7 +126,7 @@
of not hitting an error, maxlen should be >= 2*len + 3. */
Bytecount
-msw_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
+mswindows_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
Bytecount maxlen, Emchar *accel,
Lisp_Object error_name)
{
@@ -209,7 +209,7 @@
/* Left flush part of the string */
ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH);
- ll = msw_translate_menu_or_dialog_item ((Bufbyte *) buf, ll,
+ ll = mswindows_translate_menu_or_dialog_item ((Bufbyte *) buf, ll,
MAX_MENUITEM_LENGTH, accel,
XGUI_ITEM (gui_item)->name);
@@ -668,7 +668,7 @@
}
int
-msw_char_is_accelerator (struct frame *f, Emchar ch)
+mswindows_char_is_accelerator (struct frame *f, Emchar ch)
{
Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
@@ -807,7 +807,8 @@
/* We cannot pass hmenu as a lisp object. Use static var */
wm_initmenu_menu = hmenu;
wm_initmenu_frame = frm;
- return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil);
+ return mswindows_protect_modal_loop ("Error during menu handling",
+ unsafe_handle_wm_initmenupopup, Qnil);
}
Lisp_Object
@@ -817,7 +818,8 @@
if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu)
{
wm_initmenu_frame = f;
- return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+ return mswindows_protect_modal_loop ("Error during menu handling",
+ unsafe_handle_wm_initmenu, Qnil);
}
return Qt;
}
Index: src/ntproc.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/ntproc.c,v
retrieving revision 1.14.2.18
diff -u -w -r1.14.2.18 ntproc.c
--- ntproc.c 2000/03/13 07:28:02 1.14.2.18
+++ ntproc.c 2000/03/20 12:16:19
@@ -111,7 +111,7 @@
#endif
}
-/* sys_signal moved to nt.c. It's now called msw_signal... */
+/* sys_signal moved to nt.c. It's now called mswindows_signal... */
/* Defined in <process.h> which conflicts with the local copy */
#define _P_NOWAIT 1
@@ -943,7 +943,7 @@
GetClassName (hwnd, window_class, sizeof (window_class));
if (strcmp (window_class,
- msw_windows9x_p()
+ mswindows_windows9x_p()
? "tty"
: "ConsoleWindowClass") == 0)
{
@@ -1036,7 +1036,7 @@
if (NILP (Vwin32_start_process_share_console) && cp &&
cp->hwnd)
{
#if 1
- if (msw_windows9x_p())
+ if (mswindows_windows9x_p())
{
/*
Another possibility is to try terminating the VDM out-right by
Index: src/process-nt.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/process-nt.c,v
retrieving revision 1.11.2.17
diff -u -w -r1.11.2.17 process-nt.c
--- process-nt.c 2000/03/13 07:28:03 1.11.2.17
+++ process-nt.c 2000/03/20 12:16:20
@@ -55,6 +55,7 @@
DWORD dwProcessId;
HWND hwnd; /* console window */
int need_enable_child_signals;
+ int selected_for_exit_notify;
};
/* Control whether create_child causes the process to inherit Emacs'
@@ -75,10 +76,16 @@
/*-----------------------------------------------------------------------*/
/* This one breaks process abstraction. Prototype is in console-msw.h,
- used by select_process method in event-msw.c */
+ used by select_process method in event-msw.c.
+
+ If called the first time on a process, return the process handle,
+ so we can select on it and receive exit notification. */
HANDLE
-get_nt_process_handle (Lisp_Process *p)
+get_nt_process_handle_only_first_time (Lisp_Process *p)
{
+ if (NT_DATA (p)->selected_for_exit_notify)
+ return INVALID_HANDLE_VALUE;
+ NT_DATA (p)->selected_for_exit_notify = 1;
return (NT_DATA (p)->h_process);
}
@@ -419,7 +426,7 @@
GetClassName (hwnd, window_class, sizeof (window_class));
if (strcmp (window_class,
- msw_windows9x_p ()
+ mswindows_windows9x_p ()
? "tty"
: "ConsoleWindowClass") == 0)
{
@@ -540,7 +547,7 @@
if (NILP (Vmswindows_start_process_share_console) && cp &&
cp->hwnd)
{
#if 1
- if (msw_windows9x_p ())
+ if (mswindows_windows9x_p ())
{
/*
Another possibility is to try terminating the VDM out-right by
@@ -678,16 +685,17 @@
static void
ensure_console_window_exists ()
{
- if (msw_windows9x_p ())
- msw_hide_console ();
+ if (mswindows_windows9x_p ())
+ mswindows_hide_console ();
}
static int
nt_create_process (Lisp_Process *p,
Lisp_Object *argv, int nargv,
- Lisp_Object program, Lisp_Object cur_dir)
+ Lisp_Object program, Lisp_Object cur_dir,
+ int separate_err)
{
- HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
+ HANDLE hmyshove, hmyslurp, hmyslurp_err, hprocin, hprocout, hprocerr;
LPTSTR command_line;
BOOL do_io, windowed;
char *proc_env;
@@ -738,19 +746,33 @@
CreatePipe (&hprocin, &hmyshove, &sa, 0);
CreatePipe (&hmyslurp, &hprocout, &sa, 0);
+ if (separate_err)
+ CreatePipe (&hmyslurp_err, &hprocerr, &sa, 0);
+ else
/* Duplicate the stdout handle for use as stderr */
- DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr,
- 0, TRUE, DUPLICATE_SAME_ACCESS);
+ DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(),
+ &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
/* Stupid Win32 allows to create a pipe with *both* ends either
inheritable or not. We need process ends inheritable, and local
ends not inheritable. */
- DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), &htmp,
- 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
+ DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
+ &htmp,
+ 0, FALSE,
+ DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
hmyshove = htmp;
- DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), &htmp,
- 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
+ DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
+ &htmp,
+ 0, FALSE,
+ DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
hmyslurp = htmp;
+ if (separate_err)
+ {
+ DuplicateHandle (GetCurrentProcess(), hmyslurp_err,
+ GetCurrentProcess(), &htmp, 0, FALSE,
+ DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
+ hmyslurp_err = htmp;
+ }
}
/* Convert an argv vector into Win32 style command line by a call to
@@ -875,7 +897,7 @@
}
flags = CREATE_SUSPENDED;
- if (msw_windows9x_p ())
+ if (mswindows_windows9x_p ())
flags |= (!NILP (Vmswindows_start_process_share_console)
? CREATE_NEW_PROCESS_GROUP
: CREATE_NEW_CONSOLE);
@@ -905,6 +927,8 @@
{
CloseHandle (hmyshove);
CloseHandle (hmyslurp);
+ if (separate_err)
+ CloseHandle (hmyslurp_err);
}
signal_cannot_launch (program, GetLastError ());
}
@@ -914,7 +938,9 @@
{
NT_DATA(p)->h_process = pi.hProcess;
NT_DATA(p)->dwProcessId = pi.dwProcessId;
- init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
+ init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove,
+ separate_err ? (void *) hmyslurp_err
+ : (void *) -1, 0);
}
else
{
Index: src/process.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/process.h,v
retrieving revision 1.8.2.9
diff -u -w -r1.8.2.9 process.h
--- process.h 2000/03/13 07:28:03 1.8.2.9
+++ process.h 2000/03/20 12:16:20
@@ -66,8 +66,9 @@
void kill_buffer_processes (Lisp_Object buffer);
void close_process_descs (void);
-void set_process_filter (Lisp_Object proc,
- Lisp_Object filter, int filter_does_read);
+void set_process_filter (Lisp_Object proc, Lisp_Object filter,
+ int filter_does_read,
+ int set_stderr);
/* True iff we are about to fork off a synchronous process or if we
are waiting for it. */
@@ -86,9 +87,11 @@
int exit_code, int core_dumped);
void get_process_streams (Lisp_Process *p,
- Lisp_Object *instr, Lisp_Object *outstr);
-int get_process_selected_p (Lisp_Process *p);
-void set_process_selected_p (Lisp_Process *p, int selected_p);
+ Lisp_Object *instr, Lisp_Object *outstr,
+ Lisp_Object *errstr);
+int get_process_selected_p (Lisp_Process *p, int do_err);
+void set_process_selected_p (Lisp_Process *p, int in_selected,
+ int err_selected);
Lisp_Process *get_process_from_usid (USID usid);
@@ -117,7 +120,8 @@
child_setup (int in, int out, int err,
char **new_argv, const char *current_dir);
-Charcount read_process_output (Lisp_Object proc);
+Charcount read_process_output (Lisp_Object proc, int read_stderr);
+int process_has_separate_stderr (Lisp_Object proc);
const char *signal_name (int signum);
Index: src/menubar-x.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/menubar-x.c,v
retrieving revision 1.18.2.14
diff -u -w -r1.18.2.14 menubar-x.c
--- menubar-x.c 2000/03/13 08:16:19 1.18.2.14
+++ menubar-x.c 2000/03/20 12:16:20
@@ -222,7 +222,7 @@
{
#endif
desc = call1_trapping_errors ("Error in menubar filter",
- hook_fn, desc);
+ hook_fn, desc, INHIBIT_THROWS);
if (UNBOUNDP (desc))
desc = Qnil;
#if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
Index: src/print.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/print.c,v
retrieving revision 1.27.2.17
diff -u -w -r1.27.2.17 print.c
--- print.c 2000/03/13 10:04:29 1.27.2.17
+++ print.c 2000/03/20 12:16:21
@@ -120,7 +120,7 @@
/* we typically have no useful stdout/stderr under windows if we're
being invoked graphically. */
if (!noninteractive)
- msw_output_console_string (extptr, extlen);
+ mswindows_output_console_string (extptr, extlen);
else
#endif
{
@@ -163,7 +163,7 @@
called from fatal_error_signal().
2) (to be really correct) make a new lstream that outputs using
- msw_output_console_string(). */
+ mswindows_output_console_string(). */
static int
std_handle_out_va (FILE *stream, const char *fmt, va_list args)
Index: src/alloc.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.42.2.59
diff -u -w -r1.42.2.59 alloc.c
--- alloc.c 2000/03/16 07:04:45 1.42.2.59
+++ alloc.c 2000/03/20 12:16:22
@@ -3364,7 +3364,8 @@
gc_currently_forbidden = 1;
if (!gc_hooks_inhibited)
- run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook);
+ run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook,
+ INHIBIT_THROWS);
/* Now show the GC cursor/message. */
if (!noninteractive)
@@ -3471,6 +3472,7 @@
{
mark_object (catch->tag);
mark_object (catch->val);
+ mark_object (catch->actual_tag);
}
}
@@ -3526,7 +3528,8 @@
/******* End of garbage collection ********/
- run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook);
+ run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook,
+ INHIBIT_THROWS);
/* Now remove the GC cursor/message */
if (!noninteractive)
Index: src/emacs.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.82.2.58
diff -u -w -r1.82.2.58 emacs.c
--- emacs.c 2000/03/16 15:52:12 1.82.2.58
+++ emacs.c 2000/03/20 12:16:23
@@ -170,9 +170,9 @@
priority. */
int emacs_priority;
-/* If non-zero a filter or a sentinel is running. Tested to save the match
- data on the first attempt to change it inside asynchronous code. */
-int running_asynch_code;
+/* Some FSF junk with running_asynch_code, to preserve the match
+ data. Not necessary because we don't call process filters
+ asynchronously (i.e. from within QUIT). */
/* If non-zero, a window-system was specified on the command line. */
int display_arg;
@@ -2744,6 +2744,7 @@
DOESNT_RETURN
assert_failed (const char *file, int line, const char *expr)
{
+ DebugBreak ();
stderr_out ("Fatal error: assertion failed, file %s, line %d, %s\n",
file, line, expr);
#undef abort /* avoid infinite #define loop... */
Index: src/event-Xt.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-Xt.c,v
retrieving revision 1.41.2.23
diff -u -w -r1.41.2.23 event-Xt.c
--- event-Xt.c 2000/03/16 11:21:48 1.41.2.23
+++ event-Xt.c 2000/03/20 12:16:24
@@ -2145,39 +2145,62 @@
}
static void
-emacs_Xt_select_process (Lisp_Process *p)
+emacs_Xt_select_process (Lisp_Process *process, int doin, int doerr)
{
- Lisp_Object process;
- int infd = event_stream_unixoid_select_process (p);
+ Lisp_Object proc;
+ int infd, errfd;
- XSETPROCESS (process, p);
- select_filedesc (infd, process);
+ event_stream_unixoid_select_process (process, doin, doerr, &infd, &errfd);
+
+ XSETPROCESS (proc, process);
+ if (doin)
+ select_filedesc (infd, proc);
+ if (doerr)
+ select_filedesc (errfd, proc);
}
static void
-emacs_Xt_unselect_process (Lisp_Process *p)
+emacs_Xt_unselect_process (Lisp_Process *process, int doin, int doerr)
{
- int infd = event_stream_unixoid_unselect_process (p);
+ int infd, errfd;
+
+ event_stream_unixoid_unselect_process (process, doin, doerr, &infd, &errfd);
+ if (doin)
unselect_filedesc (infd);
+ if (doerr)
+ unselect_filedesc (errfd);
}
-static USID
-emacs_Xt_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream, Lisp_Object* outstream, int flags)
-{
- USID u = event_stream_unixoid_create_stream_pair
- (inhandle, outhandle, instream, outstream, flags);
- if (u != USID_ERROR)
- u = USID_DONTHASH;
- return u;
+static void
+emacs_Xt_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)
+{
+ event_stream_unixoid_create_io_streams
+ (inhandle, outhandle, errhandle, instream, outstream,
+ errstream, in_usid, err_usid, flags);
+ if (*in_usid != USID_ERROR)
+ *in_usid = USID_DONTHASH;
+ if (*err_usid != USID_ERROR)
+ *err_usid = USID_DONTHASH;
}
-static USID
-emacs_Xt_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
-{
- event_stream_unixoid_delete_stream_pair (instream, outstream);
- return USID_DONTHASH;
+static void
+emacs_Xt_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid)
+{
+ event_stream_unixoid_delete_io_streams
+ (instream, outstream, errstream, in_usid, err_usid);
+ *in_usid = USID_DONTHASH;
+ *err_usid = USID_DONTHASH;
}
/* This is called from GC when a process object is about to be freed.
@@ -2188,12 +2211,13 @@
{
#if 0 /* #### */
int i;
- Lisp_Object instr, outstr;
+ Lisp_Object instr, outstr, errstr;
- get_process_streams (p, &instr, &outstr);
+ get_process_streams (p, &instr, &outstr, &errstr);
/* if it still has fds, then it hasn't been killed yet. */
assert (NILP(instr));
assert (NILP(outstr));
+ assert (NILP(errstr));
/* Better not still be in the "with input" table; we know it's got no
fds. */
for (i = 0; i < MAXDESC; i++)
{
@@ -3105,8 +3129,8 @@
Xt_event_stream->select_process_cb = emacs_Xt_select_process;
Xt_event_stream->unselect_process_cb = emacs_Xt_unselect_process;
Xt_event_stream->quit_p_cb = emacs_Xt_quit_p;
- Xt_event_stream->create_stream_pair_cb = emacs_Xt_create_stream_pair;
- Xt_event_stream->delete_stream_pair_cb = emacs_Xt_delete_stream_pair;
+ Xt_event_stream->create_io_streams_cb = emacs_Xt_create_io_streams;
+ Xt_event_stream->delete_io_streams_cb = emacs_Xt_delete_io_streams;
the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype);
Index: src/event-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v
retrieving revision 1.38.2.41
diff -u -w -r1.38.2.41 event-msw.c
--- event-msw.c 2000/03/16 11:21:48 1.38.2.41
+++ event-msw.c 2000/03/20 12:16:26
@@ -129,6 +129,14 @@
#ifndef HAVE_MSG_SELECT
/* List of mswindows waitable handles. */
static HANDLE mswindows_waitable_handles[MAX_WAITABLE];
+/* For each waitable handle referring to an actual process (not the
+ process's input or err, i.e. a handle used for catching a process
+ exit), return the associated process.
+
+ We do NOT gcpro these processes! (This should be safe, because the
+ processes are on Vprocess_list. If not, then usid_to_process is not
+ safe, either.) */
+static Lisp_Process *mswindows_process_of_handle[MAX_WAITABLE];
/* Number of wait handles */
static int mswindows_waitable_count=0;
@@ -153,7 +161,7 @@
/* This is the event signaled by the event pump.
See mswindows_pump_outstanding_events for comments */
-static Lisp_Object mswindows_error_caught_in_modal_loop;
+static int mswindows_error_caught_in_modal_loop;
static int mswindows_in_modal_loop;
/* Count of wound timers */
@@ -1087,26 +1095,36 @@
}
static BOOL
-add_waitable_handle (HANDLE h)
+add_waitable_handle (HANDLE h, Lisp_Process *p)
{
assert (find_waitable_handle (h) < 0);
if (mswindows_waitable_count == MAX_WAITABLE)
return FALSE;
- mswindows_waitable_handles [mswindows_waitable_count++] = h;
+ mswindows_waitable_handles [mswindows_waitable_count] = h;
+ mswindows_process_of_handle [mswindows_waitable_count] = p;
+ mswindows_waitable_count++;
return TRUE;
}
static void
+remove_waitable_handle_1 (int ix)
+{
+ --mswindows_waitable_count;
+ mswindows_waitable_handles [ix] =
+ mswindows_waitable_handles [mswindows_waitable_count];
+ mswindows_process_of_handle [ix] =
+ mswindows_process_of_handle [mswindows_waitable_count];
+}
+
+static void
remove_waitable_handle (HANDLE h)
{
int ix = find_waitable_handle (h);
- if (ix < 0)
- return;
-
- mswindows_waitable_handles [ix] =
- mswindows_waitable_handles [--mswindows_waitable_count];
+ assert (ix >= 0);
+ remove_waitable_handle_1 (ix);
}
+
#endif /* HAVE_MSG_SELECT */
@@ -1114,24 +1132,38 @@
/* Event pump */
/************************************************************************/
+struct mswindows_protect_modal_loop
+{
+ Lisp_Object (*bfun) (Lisp_Object barg);
+ Lisp_Object barg;
+};
+
static Lisp_Object
-mswindows_modal_loop_error_handler (Lisp_Object cons_sig_data,
- Lisp_Object u_n_u_s_e_d)
+mswindows_protect_modal_loop_1 (void *gack)
{
- mswindows_error_caught_in_modal_loop = cons_sig_data;
- return Qunbound;
+ struct mswindows_protect_modal_loop *gata =
+ (struct mswindows_protect_modal_loop *) gack;
+
+ return (gata->bfun) (gata->barg);
}
Lisp_Object
-mswindows_protect_modal_loop (Lisp_Object (*bfun) (Lisp_Object barg),
+mswindows_protect_modal_loop (const char *error_string,
+ Lisp_Object (*bfun) (Lisp_Object barg),
Lisp_Object barg)
{
Lisp_Object tmp;
+ struct mswindows_protect_modal_loop bluh;
+
+ bluh.bfun = bfun;
+ bluh.barg = barg;
++mswindows_in_modal_loop;
- tmp = condition_case_1 (Qt,
- bfun, barg,
- mswindows_modal_loop_error_handler, Qnil);
+ tmp = call_trapping_problems (error_string,
+ mswindows_protect_modal_loop_1, &bluh,
+ INHIBIT_THROWS, 0);
+ if (UNBOUNDP (tmp))
+ mswindows_error_caught_in_modal_loop = 1;
--mswindows_in_modal_loop;
return tmp;
@@ -1140,15 +1172,7 @@
void
mswindows_unmodalize_signal_maybe (void)
{
- if (!NILP (mswindows_error_caught_in_modal_loop))
- {
- /* Got an error while messages were pumped while
- in window procedure - have to resignal */
- Lisp_Object sym = XCAR (mswindows_error_caught_in_modal_loop);
- Lisp_Object data = XCDR (mswindows_error_caught_in_modal_loop);
- mswindows_error_caught_in_modal_loop = Qnil;
- Fsignal (sym, data);
- }
+ mswindows_error_caught_in_modal_loop = 0;
}
/*
@@ -1196,26 +1220,23 @@
* Return value is Qt if no errors was trapped, or Qunbound if
* there was an error.
*
- * In case of error, a cons representing the error, in the
- * form (SIGNAL . DATA), is stored in the module local variable
- * mswindows_error_caught_in_modal_loop. This error is signaled
- * again when DispatchMessage returns. Thus, Windows internal
- * modal loops are protected against throws, which are proven
- * to corrupt internal Windows structures.
+ * In case of error, a warning is issued and the module local variable
+ * mswindows_error_caught_in_modal_loop is set to non-zero. Thus,
+ * Windows internal modal loops are protected against throws, which
+ * are proven to corrupt internal Windows structures.
*
* In case of success, mswindows_error_caught_in_modal_loop is
- * assigned Qnil.
+ * assigned 0.
*
* If the value of mswindows_error_caught_in_modal_loop is not
- * nil already upon entry, the function just returns non-nil.
+ * zero already upon entry, the function just returns non-nil.
* This situation means that a new event has been queued while
* in cancel mode. The event will be dequeued on the next regular
* call of next-event; the pump is off since error is caught.
* The caller must *unconditionally* cancel modal loop if the
* value returned by this function is nil. Otherwise, everything
* will become frozen until the modal loop exits under normal
- * condition (scrollbar drag is released, menu closed etc.)
- */
+ * condition (scrollbar drag is released, menu closed etc.) */
Lisp_Object
mswindows_pump_outstanding_events (void)
{
@@ -1225,8 +1246,9 @@
struct gcpro gcpro1;
GCPRO1 (result);
- if (NILP(mswindows_error_caught_in_modal_loop))
- result = mswindows_protect_modal_loop (mswindows_unsafe_pump_events, Qnil);
+ if (!mswindows_error_caught_in_modal_loop)
+ result = mswindows_protect_modal_loop
+ ("Error during event handling", mswindows_unsafe_pump_events, Qnil);
UNGCPRO;
return result;
}
@@ -1245,6 +1267,12 @@
while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE))
{
+ if (mswindows_is_dialog_msg (&msg))
+ {
+ mswindows_unmodalize_signal_maybe ();
+ continue;
+ }
+
/* We have to translate messages that are not sent to the main
window. This is so that key presses work ok in things like
edit fields. However, we *musn't* translate message for the
@@ -1437,6 +1465,23 @@
FALSE, badly_p ? INFINITE : 0,
QS_ALLINPUT);
+ if (active < 0)
+ {
+ LPVOID lpMsgBuf;
+ int errval = GetLastError();
+
+ FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL, errval,
+ MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
+ (LPTSTR) &lpMsgBuf,
+ 0,
+ NULL);
+ stderr_out ("error in MsgWaitForMultipleObjects %d: %s\n",
+ errval, lpMsgBuf);
+ abort ();
+ }
+
/* This will assert if handle being waited for becomes abandoned.
Not the case currently tho */
assert ((!badly_p && active == WAIT_TIMEOUT) ||
@@ -1458,7 +1503,8 @@
int ix = active - WAIT_OBJECT_0;
/* First, try to find which process' output has signaled */
Lisp_Process *p =
- get_process_from_usid (HANDLE_TO_USID (mswindows_waitable_handles[ix]));
+ get_process_from_usid (HANDLE_TO_USID
+ (mswindows_waitable_handles[ix]));
if (p != NULL)
{
/* Found a signaled process input handle */
@@ -1468,13 +1514,15 @@
{
/* None. This means that the process handle itself has signaled.
Remove the handle from the wait vector, and make status_notify
- note the exited process */
+ note the exited process. */
mswindows_waitable_handles [ix] =
mswindows_waitable_handles [--mswindows_waitable_count];
kick_status_notify ();
- /* Have to return something: there may be no accompanying
- process event */
- mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE);
+ /* We need to return a process event here so that
+ (1) accept-process-output will return when called on this
+ process, and (2) status notifications will happen in
+ accept-process-output, sleep-for, and sit-for. */
+ mswindows_enqueue_process_event (mswindows_process_of_handle[ix]);
}
}
#endif
@@ -1532,8 +1580,10 @@
HSZPAIR pairs[2] = {
{ mswindows_dde_service, mswindows_dde_topic_system }, { 0, 0 } };
- if (!(hszItem || DdeCmpStringHandles (hszItem, mswindows_dde_service)) &&
- !(hszTopic || DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)))
+ if (!(hszItem || DdeCmpStringHandles (hszItem,
+ mswindows_dde_service)) &&
+ !(hszTopic || DdeCmpStringHandles (hszTopic,
+ mswindows_dde_topic_system)))
return (DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE)pairs,
sizeof (pairs), 0L, 0, uFmt, 0));
}
@@ -1709,7 +1759,8 @@
case WM_CLOSE:
fobj = mswindows_find_frame (hwnd);
- mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj, Qt));
+ mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj,
+ Qt));
break;
case WM_KEYUP:
@@ -1731,10 +1782,13 @@
keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] &= ~0x80;
should_set_keymap = 1;
}
-
if (should_set_keymap
+#if 0 /* it's not clear this is needed, and it might be causing
+ alt-stickiness */
&& (message != WM_SYSKEYUP
- || NILP (Vmenu_accelerator_enabled)))
+ || NILP (Vmenu_accelerator_enabled))
+#endif
+ )
SetKeyboardState (keymap);
}
@@ -1770,7 +1824,8 @@
mswindows_enqueue_keypress_event (hwnd, keysym, mods);
else /* Normal keys & modifiers */
{
- Emchar quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd)));
+ Emchar quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console
+ (hwnd)));
BYTE keymap_orig[256];
POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) };
MSG msg, tranmsg;
@@ -1818,7 +1873,8 @@
TranslateMessage (&msg);
while (PeekMessage (&tranmsg, hwnd, WM_CHAR, WM_CHAR, PM_REMOVE)
- || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE))
+ || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR,
+ PM_REMOVE))
{
int mods1 = mods;
WPARAM ch = tranmsg.wParam;
@@ -1828,15 +1884,17 @@
upon dequeueing the event */
/* #### This might also not withstand localization, if
quit character is not a latin-1 symbol */
- if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL) &&
quit_ch + 'a' - 1 == ch)
- || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL)
&& quit_ch == ch))
+ if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL)
&& quit_ch +
+ 'a' - 1 == ch)
+ || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL)
&&
+ quit_ch == ch))
&& ((mods & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) == 0))
{
mods1 |= FAKE_MOD_QUIT;
++mswindows_quit_chars_count;
}
else if (potential_accelerator && !got_accelerator &&
- msw_char_is_accelerator (frame, ch))
+ mswindows_char_is_accelerator (frame, ch))
{
got_accelerator = 1;
break;
@@ -1864,7 +1922,8 @@
if one wants to exercise fingers playing chords on the mouse,
he is allowed to do that! */
mswindows_enqueue_mouse_button_event (hwnd, message,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
break;
case WM_LBUTTONUP:
@@ -1882,7 +1941,8 @@
msframe->button2_is_down = 0;
msframe->ignore_next_rbutton_up = 1;
mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
else
{
@@ -1890,10 +1950,12 @@
{
msframe->button2_need_rbutton = 0;
mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONUP,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
break;
@@ -1912,7 +1974,8 @@
msframe->button2_is_down = 0;
msframe->ignore_next_lbutton_up = 1;
mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
else
{
@@ -1920,10 +1983,12 @@
{
msframe->button2_need_lbutton = 0;
mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONUP,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
break;
@@ -1935,10 +2000,12 @@
KillTimer (hwnd, BUTTON_2_TIMER_ID);
msframe->button2_need_lbutton = 0;
msframe->button2_need_rbutton = 0;
- if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS
(lParam)))
+ if (mswindows_button2_near_enough (msframe->last_click_point,
+ MAKEPOINTS (lParam)))
{
mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
msframe->button2_is_down = 1;
}
else
@@ -1946,7 +2013,8 @@
mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN,
msframe->last_click_point, msframe->last_click_time);
mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
}
else
@@ -1966,18 +2034,22 @@
KillTimer (hwnd, BUTTON_2_TIMER_ID);
msframe->button2_need_lbutton = 0;
msframe->button2_need_rbutton = 0;
- if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS
(lParam)))
+ if (mswindows_button2_near_enough (msframe->last_click_point,
+ MAKEPOINTS (lParam)))
{
mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
msframe->button2_is_down = 1;
}
else
{
mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN,
- msframe->last_click_point, msframe->last_click_time);
+ msframe->last_click_point,
+ msframe->last_click_time);
mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN,
- MAKEPOINTS (lParam), GetMessageTime());
+ MAKEPOINTS (lParam),
+ GetMessageTime());
}
}
else
@@ -1999,13 +2071,15 @@
{
msframe->button2_need_lbutton = 0;
mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN,
- msframe->last_click_point, msframe->last_click_time);
+ msframe->last_click_point,
+ msframe->last_click_time);
}
else if (msframe->button2_need_rbutton)
{
msframe->button2_need_rbutton = 0;
mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN,
- msframe->last_click_point, msframe->last_click_time);
+ msframe->last_click_point,
+ msframe->last_click_time);
}
}
else
@@ -2114,7 +2188,8 @@
case WM_SIZE:
/* We only care about this message if our size has really changed */
- if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED)
+ if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED ||
+ wParam==SIZE_MINIMIZED)
{
RECT rect;
int columns, rows;
@@ -2281,7 +2356,8 @@
int delta = (short) HIWORD (wParam); /* Wheel rotation amount */
struct gcpro gcpro1, gcpro2;
- if (mswindows_handle_mousewheel_event (mswindows_find_frame (hwnd), keys, delta))
+ if (mswindows_handle_mousewheel_event (mswindows_find_frame (hwnd), keys,
+ delta))
{
GCPRO2 (emacs_event, fobj);
mswindows_pump_outstanding_events (); /* Can GC */
@@ -2479,7 +2555,8 @@
#endif
#ifdef __CYGWIN32__
- filename = xmalloc (cygwin32_win32_to_posix_path_list_buf_size (fname) + 5);
+ filename = xmalloc (cygwin32_win32_to_posix_path_list_buf_size
+ (fname) + 5);
strcpy (filename, "file:");
cygwin32_win32_to_posix_path_list (fname, filename+5);
#else
@@ -2866,12 +2943,13 @@
}
#ifndef HAVE_MSG_SELECT
+
static HANDLE
get_process_input_waitable (Lisp_Process *process)
{
- Lisp_Object instr, outstr, p;
+ Lisp_Object instr, outstr, errstr, p;
XSETPROCESS (p, process);
- get_process_streams (process, &instr, &outstr);
+ get_process_streams (process, &instr, &outstr, &errstr);
assert (!NILP (instr));
#if defined (HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT)
return (network_connection_p (p)
@@ -2882,39 +2960,96 @@
#endif
}
+static HANDLE
+get_process_stderr_waitable (Lisp_Process *process)
+{
+ Lisp_Object instr, outstr, errstr, p;
+ XSETPROCESS (p, process);
+ get_process_streams (process, &instr, &outstr, &errstr);
+ if (NILP (errstr))
+ return INVALID_HANDLE_VALUE;
+ return get_ntpipe_input_stream_waitable (XLSTREAM (errstr));
+}
+
static void
-emacs_mswindows_select_process (Lisp_Process *process)
+emacs_mswindows_select_process (Lisp_Process *process, int doin, int doerr)
{
- HANDLE hev = get_process_input_waitable (process);
+ HANDLE hev = INVALID_HANDLE_VALUE;
+ HANDLE herr = INVALID_HANDLE_VALUE;
- if (!add_waitable_handle (hev))
- error ("Too many active processes");
+ if (doin)
+ {
+ hev = get_process_input_waitable (process);
+ if (!add_waitable_handle (hev, 0))
+ {
+ hev = INVALID_HANDLE_VALUE;
+ goto err;
+ }
+ }
+ if (doerr)
+ {
+ herr = get_process_stderr_waitable (process);
+ if (herr != INVALID_HANDLE_VALUE && !add_waitable_handle (herr, 0))
+ {
+ herr = INVALID_HANDLE_VALUE;
+ goto err;
+ }
+ }
+
#ifdef HAVE_WIN32_PROCESSES
{
+ /* Also select on the process handle itself, so we can receive
+ exit notifications. Only do this once, not each time this
+ function is called (which can happen many times, e.g. if
+ (set-process-filter proc t) is called and then a process filter
+ is set again). It will be unselected in mswindows_need_event(). */
Lisp_Object p;
XSETPROCESS (p, process);
if (!network_connection_p (p))
- {
- HANDLE hprocess = get_nt_process_handle (process);
- if (!add_waitable_handle (hprocess))
{
- remove_waitable_handle (hev);
- error ("Too many active processes");
- }
+ HANDLE hprocess = get_nt_process_handle_only_first_time (process);
+ if (hprocess != INVALID_HANDLE_VALUE
+ && !add_waitable_handle (hprocess, process))
+ goto err;
}
}
#endif
+
+ return;
+
+ err:
+ if (hev != INVALID_HANDLE_VALUE)
+ remove_waitable_handle (hev);
+ if (herr != INVALID_HANDLE_VALUE)
+ remove_waitable_handle (herr);
+ {
+ Lisp_Object proc;
+
+ XSETPROCESS (proc, process);
+ signal_simple_error ("Too many active processes", proc);
+ }
}
static void
-emacs_mswindows_unselect_process (Lisp_Process *process)
+emacs_mswindows_unselect_process (Lisp_Process *process, int doin, int doerr)
{
+ if (doin)
+ {
/* Process handle is removed in the event loop as soon
as it is signaled, so don't bother here about it */
HANDLE hev = get_process_input_waitable (process);
remove_waitable_handle (hev);
}
+ if (doerr)
+ {
+ /* Process handle is removed in the event loop as soon
+ as it is signaled, so don't bother here about it */
+ HANDLE herr = get_process_stderr_waitable (process);
+ if (herr != INVALID_HANDLE_VALUE)
+ remove_waitable_handle (herr);
+ }
+}
#endif /* HAVE_MSG_SELECT */
static void
@@ -2976,33 +3111,45 @@
}
}
-USID
-emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream,
+static void
+emacs_mswindows_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)
{
/* Handles for streams */
- HANDLE hin, hout;
+ HANDLE hin, hout, herr;
/* fds. These just stored along with the streams, and are closed in
delete stream pair method, because we need to handle fake unices
here. */
- int fdi, fdo;
+ int fdi, fdo, fde;
- /* Decode inhandle and outhandle. Their meaning depends on
+ /* Decode inhandle, outhandle, errhandle. Their meaning depends on
the process implementation being used. */
#if defined (HAVE_WIN32_PROCESSES)
/* We're passed in Windows handles. That's what we like most... */
hin = (HANDLE) inhandle;
hout = (HANDLE) outhandle;
- fdi = fdo = -1;
+ if (errhandle == (void *) -1)
+ herr = INVALID_HANDLE_VALUE;
+ else
+ herr = (HANDLE) errhandle;
+ fdi = fdo = fde = -1;
#elif defined (HAVE_UNIX_PROCESSES)
/* We are passed UNIX fds. This must be Cygwin.
Fetch os handles */
- hin = inhandle >= 0 ? (HANDLE)get_osfhandle ((int)inhandle) : INVALID_HANDLE_VALUE;
- hout = outhandle >= 0 ? (HANDLE)get_osfhandle ((int)outhandle) :
INVALID_HANDLE_VALUE;
+ hin = inhandle >= 0 ? (HANDLE)get_osfhandle ((int)inhandle) :
+ INVALID_HANDLE_VALUE;
+ hout = outhandle >= 0 ? (HANDLE)get_osfhandle ((int)outhandle) :
+ INVALID_HANDLE_VALUE;
+ hout = errhandle >= 0 ? (HANDLE)get_osfhandle ((int)errhandle) :
+ INVALID_HANDLE_VALUE;
fdi=(int)inhandle;
fdo=(int)outhandle;
+ fde=(int)errhandle;
#else
#error "So, WHICH kind of processes do you want?"
#endif
@@ -3015,6 +3162,10 @@
#endif
: make_ntpipe_input_stream (hin, fdi));
+ *errstream = (herr == INVALID_HANDLE_VALUE
+ ? Qnil
+ : make_ntpipe_input_stream (herr, fde));
+
#ifdef HAVE_WIN32_PROCESSES
*outstream = (hout == INVALID_HANDLE_VALUE
? Qnil
@@ -3034,23 +3185,35 @@
{
Bufbyte eof_char = get_eof_char (fdo);
int pty_max_bytes = get_pty_max_bytes (fdo);
- filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes, eof_char);
+ filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes,
+ eof_char);
}
#endif
#endif
- return (NILP (*instream)
+ *in_usid =
+ (NILP (*instream)
? USID_ERROR
#if defined(HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT)
: flags & STREAM_NETWORK_CONNECTION
? HANDLE_TO_USID (get_winsock_stream_waitable (XLSTREAM (*instream)))
#endif
- : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM (*instream))));
+ : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM
+ (*instream))));
+
+ *err_usid =
+ (NILP (*errstream)
+ ? USID_DONTHASH
+ : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM
+ (*errstream))));
}
-USID
-emacs_mswindows_delete_stream_pair (Lisp_Object instream,
- Lisp_Object outstream)
+static void
+emacs_mswindows_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid)
{
/* Oh nothing special here for Win32 at all */
#if defined (HAVE_UNIX_PROCESSES)
@@ -3063,20 +3226,32 @@
: get_ntpipe_input_stream_param (XLSTREAM (instream)));
int out = (NILP(outstream) ? -1
: filedesc_stream_fd (XLSTREAM (outstream)));
+ int err = (NILP(errstream) ? -1
+ : get_ntpipe_input_stream_param (XLSTREAM (errstream)));
if (in >= 0)
close (in);
if (out != in && out >= 0)
close (out);
+ if (err != in && err != out && err >= 0)
+ close (err);
#endif
- return (NILP (instream)
+ *in_usid =
+ (NILP (instream)
? USID_DONTHASH
#if defined(HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT)
: LSTREAM_TYPE_P (XLSTREAM (instream), winsock)
? HANDLE_TO_USID (get_winsock_stream_waitable (XLSTREAM (instream)))
#endif
- : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM (instream))));
+ : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM
+ (instream))));
+
+ *err_usid =
+ (NILP (errstream)
+ ? USID_DONTHASH
+ : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM
+ (errstream))));
}
#ifndef HAVE_X_WINDOWS
@@ -3087,12 +3262,13 @@
debug_process_finalization (Lisp_Process *p)
{
#if 0 /* #### */
- Lisp_Object instr, outstr;
+ Lisp_Object instr, outstr, errstr;
- get_process_streams (p, &instr, &outstr);
+ get_process_streams (p, &instr, &outstr, &errstr);
/* if it still has fds, then it hasn't been killed yet. */
assert (NILP(instr));
assert (NILP(outstr));
+ assert (NILP(errstr));
/* #### More checks here */
#endif
@@ -3125,13 +3301,13 @@
(void (*)(Lisp_Process*))event_stream_unixoid_select_process;
mswindows_event_stream->unselect_process_cb =
(void (*)(Lisp_Process*))event_stream_unixoid_unselect_process;
- mswindows_event_stream->create_stream_pair_cb =
event_stream_unixoid_create_stream_pair;
- mswindows_event_stream->delete_stream_pair_cb =
event_stream_unixoid_delete_stream_pair;
+ mswindows_event_stream->create_io_streams_cb =
event_stream_unixoid_create_io_streams;
+ mswindows_event_stream->delete_io_streams_cb =
event_stream_unixoid_delete_io_streams;
#else
mswindows_event_stream->select_process_cb = emacs_mswindows_select_process;
mswindows_event_stream->unselect_process_cb = emacs_mswindows_unselect_process;
- mswindows_event_stream->create_stream_pair_cb = emacs_mswindows_create_stream_pair;
- mswindows_event_stream->delete_stream_pair_cb = emacs_mswindows_delete_stream_pair;
+ mswindows_event_stream->create_io_streams_cb = emacs_mswindows_create_io_streams;
+ mswindows_event_stream->delete_io_streams_cb = emacs_mswindows_delete_io_streams;
#endif
}
@@ -3150,8 +3326,7 @@
mswindows_s_dispatch_event_queue_tail = Qnil;
pdump_wire (&mswindows_s_dispatch_event_queue_tail);
- mswindows_error_caught_in_modal_loop = Qnil;
- staticpro (&mswindows_error_caught_in_modal_loop);
+ mswindows_error_caught_in_modal_loop = 0;
DEFVAR_BOOL ("mswindows-alt-by-itself-activates-menu",
&mswindows_alt_by_itself_activates_menu /*
Index: src/event-tty.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-tty.c,v
retrieving revision 1.4.2.5
diff -u -w -r1.4.2.5 event-tty.c
--- event-tty.c 2000/03/16 11:21:50 1.4.2.5
+++ event-tty.c 2000/03/20 12:16:26
@@ -194,15 +194,19 @@
static void
-emacs_tty_select_process (Lisp_Process *process)
+emacs_tty_select_process (Lisp_Process *process, int doin, int doerr)
{
- event_stream_unixoid_select_process (process);
+ int infd, errfd;
+
+ event_stream_unixoid_select_process (process, doin, doerr, &infd, &errfd);
}
static void
-emacs_tty_unselect_process (Lisp_Process *process)
+emacs_tty_unselect_process (Lisp_Process *process, int doin, int doerr)
{
- event_stream_unixoid_unselect_process (process);
+ int infd, errfd;
+
+ event_stream_unixoid_unselect_process (process, doin, doerr, &infd, &errfd);
}
static void
@@ -224,18 +228,29 @@
This could change. */
}
-static USID
-emacs_tty_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream, Lisp_Object* outstream, int flags)
-{
- return event_stream_unixoid_create_stream_pair
- (inhandle, outhandle, instream, outstream, flags);
+static void
+emacs_tty_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)
+{
+ event_stream_unixoid_create_io_streams
+ (inhandle, outhandle, errhandle, instream, outstream,
+ errstream, in_usid, err_usid, flags);
}
-static USID
-emacs_tty_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
+static void
+emacs_tty_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid)
{
- return event_stream_unixoid_delete_stream_pair (instream, outstream);
+ event_stream_unixoid_delete_io_streams
+ (instream, outstream, errstream, in_usid, err_usid);
}
@@ -259,8 +274,8 @@
tty_event_stream->select_process_cb = emacs_tty_select_process;
tty_event_stream->unselect_process_cb = emacs_tty_unselect_process;
tty_event_stream->quit_p_cb = emacs_tty_quit_p;
- tty_event_stream->create_stream_pair_cb = emacs_tty_create_stream_pair;
- tty_event_stream->delete_stream_pair_cb = emacs_tty_delete_stream_pair;
+ tty_event_stream->create_io_streams_cb = emacs_tty_create_io_streams;
+ tty_event_stream->delete_io_streams_cb = emacs_tty_delete_io_streams;
}
void
Index: src/events.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/events.h,v
retrieving revision 1.20.2.10
diff -u -w -r1.20.2.10 events.h
--- events.h 2000/03/16 11:21:50 1.20.2.10
+++ events.h 2000/03/20 12:16:26
@@ -115,9 +115,9 @@
unselect_device_cb (those that use select() and file descriptors and
have a separate input fd per device).
- create_stream_pair_cb These callbacks are called by process code to
- delete_stream_pair_cb create and delete a pair of input and output lstreams
- which are used for subprocess I/O.
+ create_io_streams_cb These callbacks are called by process code to
+ delete_io_streams_cb create the input and output lstreams which are used
+ for subprocess I/O.
quitp_cb A handler function called from the `QUIT' macro which
should check whether the quit character has been
@@ -286,7 +286,7 @@
In this case, the handles passed are unix file descriptors, and the code
may deal with these directly. Although, the same code may be used on Win32
system with X-Windows. In this case, Win32 process implementation passes
- handles of type HANDLE, and the create_stream_pair function must call
+ handles of type HANDLE, and the create_io_streams function must call
appropriate function to get file descriptors given HANDLEs, so that these
descriptors may be passed to XtAddInput.
@@ -326,19 +326,24 @@
void (*remove_timeout_cb) (int);
void (*select_console_cb) (struct console *);
void (*unselect_console_cb) (struct console *);
- void (*select_process_cb) (Lisp_Process *);
- void (*unselect_process_cb) (Lisp_Process *);
+ void (*select_process_cb) (Lisp_Process *, int doin, int doerr);
+ void (*unselect_process_cb) (Lisp_Process *, int doin, int doerr);
void (*quit_p_cb) (void);
void (*force_event_pending) (struct frame* f);
- USID (*create_stream_pair_cb) (void* /* inhandle*/, void* /*outhandle*/ ,
+ void (*create_io_streams_cb) (void* /* inhandle*/, void* /*outhandle*/ ,
+ void * /* errhandle*/,
Lisp_Object* /* instream */,
Lisp_Object* /* outstream */,
+ Lisp_Object* /* errstream */,
+ USID * /* in_usid */, USID * /* err_usid */,
int /* flags */);
- USID (*delete_stream_pair_cb) (Lisp_Object /* instream */,
- Lisp_Object /* outstream */);
+ void (*delete_io_streams_cb) (Lisp_Object /* instream */,
+ Lisp_Object /* outstream */,
+ Lisp_Object /* errstream */,
+ USID * /* in_usid */, USID * /* err_usid */);
};
-/* Flags for create_stream_pair_cb() FLAGS parameter */
+/* Flags for create_io_streams_cb() FLAGS parameter */
#define STREAM_PTY_FLUSHING 0x0001
#define STREAM_NETWORK_CONNECTION 0x0002
@@ -576,12 +581,22 @@
void event_stream_handle_magic_event (Lisp_Event *event);
void event_stream_select_console (struct console *con);
void event_stream_unselect_console (struct console *con);
-void event_stream_select_process (Lisp_Process *proc);
-void event_stream_unselect_process (Lisp_Process *proc);
-USID event_stream_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream, Lisp_Object* outstream, int flags);
-USID event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream);
+void event_stream_select_process (Lisp_Process *proc, int doin, int doerr);
+void event_stream_unselect_process (Lisp_Process *proc, int doin, int 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);
+void event_stream_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid);
void event_stream_quit_p (void);
+void run_pre_idle_hook (void);
struct low_level_timeout
{
@@ -640,16 +655,25 @@
int event_stream_unixoid_select_console (struct console *con);
int event_stream_unixoid_unselect_console (struct console *con);
-int event_stream_unixoid_select_process (Lisp_Process *proc);
-int event_stream_unixoid_unselect_process (Lisp_Process *proc);
+void event_stream_unixoid_select_process (Lisp_Process *proc, int doin,
+ int doerr, int *infd, int *errfd);
+void event_stream_unixoid_unselect_process (Lisp_Process *proc, int doin,
+ int doerr, int *infd, int *errfd);
int read_event_from_tty_or_stream_desc (Lisp_Event *event,
struct console *con, int fd);
-USID event_stream_unixoid_create_stream_pair (void* inhandle, void* outhandle,
+void event_stream_unixoid_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);
-USID event_stream_unixoid_delete_stream_pair (Lisp_Object instream,
- Lisp_Object outstream);
+void event_stream_unixoid_delete_io_streams (Lisp_Object instream,
+ Lisp_Object outstream,
+ Lisp_Object errstream,
+ USID* in_usid,
+ USID* err_usid);
/* Beware: this evil macro evaluates its arg many times */
#define FD_TO_USID(fd) ((fd)==0 ? (USID)999999 : ((fd)<0 ? USID_DONTHASH :
(USID)(fd)))
Index: src/frame-msw.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/frame-msw.c,v
retrieving revision 1.29.2.19
diff -u -w -r1.29.2.19 frame-msw.c
--- frame-msw.c 2000/03/16 11:21:51 1.29.2.19
+++ frame-msw.c 2000/03/20 12:16:26
@@ -639,7 +639,7 @@
not restrictive since this will happen later anyway in WM_SIZE. We
have to do this after adjusting the rect to account for menubar
etc. */
- msw_get_workspace_coords (&ws_rect);
+ mswindows_get_workspace_coords (&ws_rect);
pixel_width = rect.right - rect.left;
pixel_height = rect.bottom - rect.top;
if (pixel_width > ws_rect.right - ws_rect.left)
Index: src/frame.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/frame.c,v
retrieving revision 1.37.2.28
diff -u -w -r1.37.2.28 frame.c
--- frame.c 2000/03/13 07:27:57 1.37.2.28
+++ frame.c 2000/03/20 12:16:27
@@ -645,7 +645,8 @@
else
keep_char_size =
NILP (call1_trapping_errors ("Error in adjust-frame-function",
- Vadjust_frame_function, frame));
+ Vadjust_frame_function, frame,
+ INHIBIT_THROWS));
if (keep_char_size)
Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)),
Index: src/lisp.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.38.2.53
diff -u -w -r1.38.2.53 lisp.h
--- lisp.h 2000/03/16 07:04:50 1.38.2.53
+++ lisp.h 2000/03/20 12:16:28
@@ -1100,8 +1100,19 @@
/*********** subr ***********/
-typedef Lisp_Object (*lisp_fn_t) (void);
+/* A function that takes 0 through 8 Lisp_Object arguments, respectively, and
+ returns a Lisp_Object. */
+typedef Lisp_Object (*lisp_fn_t) (EXFUN_0);
+typedef Lisp_Object (*lisp_fn1_t) (EXFUN_1);
+typedef Lisp_Object (*lisp_fn2_t) (EXFUN_2);
+typedef Lisp_Object (*lisp_fn3_t) (EXFUN_3);
+typedef Lisp_Object (*lisp_fn4_t) (EXFUN_4);
+typedef Lisp_Object (*lisp_fn5_t) (EXFUN_5);
+typedef Lisp_Object (*lisp_fn6_t) (EXFUN_6);
+typedef Lisp_Object (*lisp_fn7_t) (EXFUN_7);
+typedef Lisp_Object (*lisp_fn8_t) (EXFUN_8);
+
struct Lisp_Subr
{
struct lrecord_header lheader;
@@ -1762,6 +1773,21 @@
gcpro5.next = &gcpro4, gcpro5.var = &var5, gcpro5.nvars = 1, \
gcprolist = &gcpro5 ))
+#define GCPRO1_ARRAY(array, n) ((void) ( \
+ gcpro1.next = gcprolist, gcpro1.var = array, gcpro1.nvars = n, \
+ gcprolist = &gcpro1 ))
+
+#define GCPRO2_ARRAY(array1, n1, array2, n2) ((void) ( \
+ gcpro1.next = gcprolist, gcpro1.var = array1, gcpro1.nvars = n1, \
+ gcpro2.next = &gcpro1, gcpro2.var = array2, gcpro2.nvars = n2, \
+ gcprolist = &gcpro2 ))
+
+#define GCPRO3_ARRAY(array1, n1, array2, n2, array3, n3) ((void) ( \
+ gcpro1.next = gcprolist, gcpro1.var = array1, gcpro1.nvars = n1, \
+ gcpro2.next = &gcpro1, gcpro2.var = array2, gcpro2.nvars = n2, \
+ gcpro3.next = &gcpro2, gcpro3.var = array3, gcpro3.nvars = n3, \
+ gcprolist = &gcpro3 ))
+
#define UNGCPRO ((void) (gcprolist = gcpro1.next))
#define NGCPRO1(var1) ((void) ( \
@@ -1794,6 +1820,21 @@
ngcpro5.next = &ngcpro4, ngcpro5.var = &var5, ngcpro5.nvars = 1, \
gcprolist = &ngcpro5 ))
+#define NGCPRO1_ARRAY(array, n) ((void) ( \
+ ngcpro1.next = gcprolist, ngcpro1.var = array, ngcpro1.nvars = n, \
+ gcprolist = &ngcpro1 ))
+
+#define NGCPRO2_ARRAY(array1, n1, array2, n2) ((void) ( \
+ ngcpro1.next = gcprolist, ngcpro1.var = array1, ngcpro1.nvars = n1, \
+ ngcpro2.next = &ngcpro1, ngcpro2.var = array2, ngcpro2.nvars = n2, \
+ gcprolist = &ngcpro2 ))
+
+#define NGCPRO3_ARRAY(array1, n1, array2, n2, array3, n3) ((void) ( \
+ ngcpro1.next = gcprolist, ngcpro1.var = array1, ngcpro1.nvars = n1, \
+ ngcpro2.next = &ngcpro1, ngcpro2.var = array2, ngcpro2.nvars = n2, \
+ ngcpro3.next = &ngcpro2, ngcpro3.var = array3, ngcpro3.nvars = n3, \
+ gcprolist = &ngcpro3 ))
+
#define NUNGCPRO ((void) (gcprolist = ngcpro1.next))
#define NNGCPRO1(var1) ((void) ( \
@@ -1826,6 +1867,21 @@
nngcpro5.next = &nngcpro4, nngcpro5.var = &var5, nngcpro5.nvars = 1, \
gcprolist = &nngcpro5 ))
+#define NNGCPRO1_ARRAY(array, n) ((void) ( \
+ nngcpro1.next = gcprolist, nngcpro1.var = array, nngcpro1.nvars = n, \
+ gcprolist = &nngcpro1 ))
+
+#define NNGCPRO2_ARRAY(array1, n1, array2, n2) ((void) ( \
+ nngcpro1.next = gcprolist, nngcpro1.var = array1, nngcpro1.nvars = n1, \
+ nngcpro2.next = &nngcpro1, nngcpro2.var = array2, nngcpro2.nvars = n2, \
+ gcprolist = &nngcpro2 ))
+
+#define NNGCPRO3_ARRAY(array1, n1, array2, n2, array3, n3) ((void) ( \
+ nngcpro1.next = gcprolist, nngcpro1.var = array1, nngcpro1.nvars = n1, \
+ nngcpro2.next = &nngcpro1, nngcpro2.var = array2, nngcpro2.nvars = n2, \
+ nngcpro3.next = &nngcpro2, nngcpro3.var = array3, nngcpro3.nvars = n3, \
+ gcprolist = &nngcpro3 ))
+
#define NNUNGCPRO ((void) (gcprolist = nngcpro1.next))
#endif /* ! DEBUG_GCPRO */
@@ -2120,12 +2176,12 @@
extern int noninteractive, noninteractive1;
extern int preparing_for_armageddon;
extern int emacs_priority;
-extern int running_asynch_code;
extern int suppress_early_error_handler_backtrace;
/* Defined in eval.c */
DECLARE_DOESNT_RETURN (signal_error (Lisp_Object, Lisp_Object));
-void maybe_signal_error (Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior);
+void maybe_signal_error (Lisp_Object, Lisp_Object, Lisp_Object,
+ Error_behavior);
Lisp_Object maybe_signal_continuable_error (Lisp_Object, Lisp_Object,
Lisp_Object, Error_behavior);
DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (error (const char *,
@@ -2140,7 +2196,8 @@
Lisp_Object, Error_behavior);
Lisp_Object signal_simple_continuable_error (const char *, Lisp_Object);
Lisp_Object maybe_signal_simple_continuable_error (const char *, Lisp_Object,
- Lisp_Object, Error_behavior);
+ Lisp_Object,
+ Error_behavior);
DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (error_with_frob
(Lisp_Object, const char *,
...), 2, 3);
@@ -2149,7 +2206,8 @@
Lisp_Object continuable_error_with_frob (Lisp_Object, const char *,
...) PRINTF_ARGS (2, 3);
Lisp_Object maybe_continuable_error_with_frob
-(Lisp_Object, Lisp_Object, Error_behavior, const char *, ...) PRINTF_ARGS (4, 5);
+(Lisp_Object, Lisp_Object, Error_behavior, const char *, ...)
+ PRINTF_ARGS (4, 5);
DECLARE_DOESNT_RETURN (signal_simple_error_2 (const char *,
Lisp_Object, Lisp_Object));
void maybe_signal_simple_error_2 (const char *, Lisp_Object, Lisp_Object,
@@ -2207,19 +2265,51 @@
Lisp_Object eval_in_buffer (struct buffer *, Lisp_Object);
Lisp_Object call0_with_handler (Lisp_Object, Lisp_Object);
Lisp_Object call1_with_handler (Lisp_Object, Lisp_Object, Lisp_Object);
+
+struct call_trapping_problems_result
+{
+ int caught_error, caught_throw;
+ Lisp_Object error_conditions, data;
+ Lisp_Object backtrace;
+ Lisp_Object thrown_tag;
+ Lisp_Object thrown_value;
+};
+
+#define INHIBIT_THROWS 1
+#define INHIBIT_QUIT 2
+#define INHIBIT_GC 4
+
+Lisp_Object call_trapping_problems (const char *warning_string,
+ Lisp_Object (*fun) (void *),
+ void *arg,
+ int flags,
+ struct call_trapping_problems_result *
+ problem);
+
+Lisp_Object call0_trapping_errors (const char *, Lisp_Object, int);
+Lisp_Object call1_trapping_errors (const char *, Lisp_Object, Lisp_Object,
+ int);
+Lisp_Object call2_trapping_errors (const char *, Lisp_Object, Lisp_Object,
+ Lisp_Object, int);
+Lisp_Object call3_trapping_errors (const char *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, int);
+Lisp_Object call4_trapping_errors (const char *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object,
+ int);
+Lisp_Object call5_trapping_errors (const char *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, int);
Lisp_Object eval_in_buffer_trapping_errors (const char *, struct buffer *,
- Lisp_Object);
-Lisp_Object run_hook_trapping_errors (const char *, Lisp_Object);
+ Lisp_Object, int);
+Lisp_Object run_hook_trapping_errors (const char *, Lisp_Object, int);
Lisp_Object safe_run_hook_trapping_errors (const char *, Lisp_Object, int);
-Lisp_Object call0_trapping_errors (const char *, Lisp_Object);
-Lisp_Object call1_trapping_errors (const char *, Lisp_Object, Lisp_Object);
-Lisp_Object call2_trapping_errors (const char *,
- Lisp_Object, Lisp_Object, Lisp_Object);
-Lisp_Object call_with_suspended_errors (lisp_fn_t, volatile Lisp_Object, Lisp_Object,
+Lisp_Object call_with_suspended_errors (lisp_fn_t, volatile Lisp_Object,
+ Lisp_Object,
Error_behavior, int, ...);
/* C Code should be using internal_catch, record_unwind_p, condition_case_1 */
Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object),
- Lisp_Object, int * volatile);
+ Lisp_Object, int * volatile,
+ Lisp_Object * volatile);
Lisp_Object condition_case_1 (Lisp_Object,
Lisp_Object (*) (Lisp_Object),
Lisp_Object,
@@ -2632,6 +2722,8 @@
EXFUN (Fforward_line, 2);
EXFUN (Ffset, 2);
EXFUN (Ffuncall, MANY);
+EXFUN (Ffunction_min_args, 1);
+EXFUN (Ffunction_max_args, 1);
EXFUN (Fgeq, MANY);
EXFUN (Fget, 3);
EXFUN (Fget_buffer_process, 1);
Index: src/redisplay.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay.c,v
retrieving revision 1.55.2.49
diff -u -w -r1.55.2.49 redisplay.c
--- redisplay.c 2000/03/16 11:21:56 1.55.2.49
+++ redisplay.c 2000/03/20 12:16:31
@@ -34,10 +34,18 @@
The Golden Rules of Redisplay
First: It Is Better To Be Correct Than Fast
- Second: Thou Shalt Not Run Elisp From Within Redisplay
+ Second: Thou Shalt Use Due Caution When Running Elisp From Within Redisplay
Third: It Is Better To Be Fast Than Not To Be
****************************************************************************/
+/* Note: The second rule used to prohibit running Elisp from within redisplay,
+ but that's not correct.
+
+ Use callN_trapping_errors (..., INHIBIT_THROWS | INHIBIT_GC) instead.
+
+ --ben
+*/
+
#include <config.h>
#include "lisp.h"
#include <limits.h>
@@ -47,6 +55,7 @@
#include "debug.h"
#include "device.h"
#include "elhash.h"
+#include "events.h"
#include "extents.h"
#include "faces.h"
#include "frame.h"
@@ -6608,33 +6617,54 @@
unbind_to (count, Qnil);
}
+/* Note: All places in the C code that call redisplay() are prepared
+ to handle GCing. However, we can't currently handle GC inside the
+ guts of redisplay (#### someone should fix this), so we need to use
+ INHIBIT_GC when calling Lisp.
+
+ #### We probably can't handle any deletion of existing buffers, frames,
+ windows, devices, consoles, text changes, etc. either. We should
+
+ (a) Create the appropriate INHIBIT_ flags for this.
+ (b) In the longer run, fix redisplay to handle this.
+
+ (#### What about other external entry points to the redisplay code?
+ Someone should go through and make sure that all callers can handle
+ GC there, too.)
+*/
+
void
redisplay (void)
{
+ run_pre_idle_hook ();
+ redisplay_no_pre_idle_hook ();
+}
+
+void
+redisplay_no_pre_idle_hook (void)
+{
if (last_display_warning_tick != display_warning_tick &&
!inhibit_warning_display)
{
/* If an error occurs during this function, oh well.
If we report another warning, we could get stuck in an
infinite loop reporting warnings. */
- call0_trapping_errors (0, Qdisplay_warning_buffer);
+ call0_trapping_errors (0, Qdisplay_warning_buffer, INHIBIT_THROWS);
last_display_warning_tick = display_warning_tick;
}
/* The run_hook_trapping_errors functions are smart enough not
to do any evalling if the hook function is empty, so there
- should not be any significant time loss. All places in the
- C code that call redisplay() are prepared to handle GCing,
- so we should be OK. */
+ should not be any significant time loss. */
#ifndef INHIBIT_REDISPLAY_HOOKS
run_hook_trapping_errors ("Error in pre-redisplay-hook",
- Qpre_redisplay_hook);
+ Qpre_redisplay_hook, INHIBIT_THROWS);
#endif /* INHIBIT_REDISPLAY_HOOKS */
redisplay_without_hooks ();
#ifndef INHIBIT_REDISPLAY_HOOKS
run_hook_trapping_errors ("Error in post-redisplay-hook",
- Qpost_redisplay_hook);
+ Qpost_redisplay_hook, INHIBIT_THROWS);
#endif /* INHIBIT_REDISPLAY_HOOKS */
}
@@ -8991,6 +9021,9 @@
Normally, redisplay is preempted as normal if input arrives. However,
if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for
input and is guaranteed to proceed to completion.
+
+Note: If you simply want everything redisplayed, the current idiom is
+`(sit-for 0)'.
*/
(device, no_preempt))
{
Index: src/redisplay.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay.h,v
retrieving revision 1.7.2.25
diff -u -w -r1.7.2.25 redisplay.h
--- redisplay.h 2000/03/11 18:09:25 1.7.2.25
+++ redisplay.h 2000/03/20 12:16:32
@@ -686,6 +686,7 @@
Lisp_Object reloc,
Bytecount offset, Bytecount len);
int redisplay_frame (struct frame *f, int preemption_check);
+void redisplay_no_pre_idle_hook ();
void redisplay (void);
struct display_block *get_display_block_from_line (struct display_line *dl,
enum display_type type);
Index: src/sysdep.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/sysdep.c,v
retrieving revision 1.32.2.30
diff -u -w -r1.32.2.30 sysdep.c
--- sysdep.c 2000/03/16 07:04:51 1.32.2.30
+++ sysdep.c 2000/03/20 12:16:33
@@ -3106,9 +3106,23 @@
int
sys_readlink (const char *path, char *buf, size_t bufsiz)
{
+ int retval;
+
PATHNAME_CONVERT_OUT (path);
- /* #### currently we don't do conversions on the incoming data */
- return readlink (path, buf, bufsiz);
+ retval = readlink (path, buf, bufsiz);
+ if (retval < 0)
+ return retval;
+ {
+ Bufbyte *intbuf;
+ Bytecount tamanho;
+
+ TO_INTERNAL_FORMAT (C_STRING, path, ALLOCA, (intbuf, tamanho), Qfile_name);
+ /* the man page says this function does not null-terminate */
+ if (tamanho >= bufsiz)
+ tamanho = bufsiz;
+ memcpy (buf, intbuf, tamanho);
+ return tamanho;
+ }
}
#endif /* ENCAPSULATE_READLINK */
@@ -3117,7 +3131,11 @@
int
sys_fstat (int fd, struct stat *buf)
{
+#ifdef WINDOWSNT
+ return msw_fstat (fd, buf);
+#else
return fstat (fd, buf);
+#endif
}
#endif /* ENCAPSULATE_FSTAT */
@@ -3127,7 +3145,11 @@
sys_stat (const char *path, struct stat *buf)
{
PATHNAME_CONVERT_OUT (path);
+#ifdef WINDOWSNT
+ return msw_stat (path, buf);
+#else
return stat (path, buf);
+#endif
}
#endif /* ENCAPSULATE_STAT */
Index: src/callproc.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/callproc.c,v
retrieving revision 1.29.2.14
diff -u -w -r1.29.2.14 callproc.c
--- callproc.c 2000/02/16 02:06:50 1.29.2.14
+++ callproc.c 2000/03/20 12:16:33
@@ -152,7 +152,7 @@
}
#endif /* unused */
-DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /*
+DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /*
Call PROGRAM synchronously in separate process, with coding-system specified.
Arguments are
(PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
@@ -906,7 +906,7 @@
void
syms_of_callproc (void)
{
- DEFSUBR (Fcall_process_internal);
+ DEFSUBR (Fold_call_process_internal);
DEFSUBR (Fgetenv);
}
Index: src/event-stream.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-stream.c,v
retrieving revision 1.45.2.25
diff -u -w -r1.45.2.25 event-stream.c
--- event-stream.c 2000/03/17 17:34:39 1.45.2.25
+++ event-stream.c 2000/03/20 12:16:35
@@ -564,41 +564,68 @@
}
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);
+ cur_err = get_process_selected_p (proc, 1);
+ if (cur_in)
+ doin = 0;
+ if (cur_err)
+ doerr = 0;
+ if (doin || doerr)
{
- event_stream->select_process_cb (proc);
- set_process_selected_p (proc, 1);
+ 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);
+ cur_err = get_process_selected_p (proc, 1);
+ if (!cur_in)
+ doin = 0;
+ if (!cur_err)
+ doerr = 0;
+ if (doin || doerr)
{
- event_stream->unselect_process_cb (proc);
- set_process_selected_p (proc, 0);
+ event_stream->unselect_process_cb (proc, doin, doerr);
+ set_process_selected_p (proc, cur_in && !doin, cur_err && !doerr);
}
}
-USID
-event_stream_create_stream_pair (void* inhandle, void* outhandle,
- Lisp_Object* instream, Lisp_Object* outstream, int flags)
+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
- (inhandle, outhandle, instream, outstream, flags);
+ event_stream->create_io_streams_cb
+ (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
@@ -1310,7 +1337,7 @@
/* call1 GC-protects its arguments */
call1_trapping_errors ("Error in asynchronous timeout callback",
- humpty, dumpty);
+ humpty, dumpty, INHIBIT_THROWS | INHIBIT_GC);
}
@@ -2004,14 +2031,14 @@
UNGCPRO;
}
-static void
+void
run_pre_idle_hook (void)
{
if (!NILP (Vpre_idle_hook)
&& !detect_input_pending ())
safe_run_hook_trapping_errors
("Error in `pre-idle-hook' (setting hook to nil)",
- Qpre_idle_hook, 1);
+ Qpre_idle_hook, INHIBIT_THROWS);
}
static void push_this_command_keys (Lisp_Object event);
@@ -2133,7 +2160,7 @@
if (!EVENTP (e) || !command_event_p (e))
signal_error (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);
@@ -2153,7 +2180,7 @@
}
if (!EQ (e, event))
Fcopy_event (e, event);
- redisplay ();
+ redisplay_no_pre_idle_hook ();
DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
}
@@ -2165,7 +2192,7 @@
{
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;
@@ -2176,7 +2203,6 @@
recent-keys. */
else
{
- run_pre_idle_hook ();
redisplay ();
next_event_internal (event, 1);
Vquit_flag = Qnil; /* Read C-g as an event. */
@@ -2652,6 +2678,9 @@
unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
Fdeallocate_event (event);
+
+ status_notify ();
+
UNGCPRO;
current_buffer = old_buffer;
return result;
@@ -2769,10 +2798,7 @@
if (!NILP(recursive_sit_for))
{
if (!event_stream_event_pending_p (1) && NILP (nodisplay))
- {
- run_pre_idle_hook ();
redisplay ();
- }
return Qnil;
}
@@ -2801,10 +2827,7 @@
/* 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))
@@ -2949,9 +2972,14 @@
{
Lisp_Object p = XEVENT (event)->event.process.process;
Charcount readstatus;
+ int iter;
assert (PROCESSP (p));
- while ((readstatus = read_process_output (p)) > 0)
+ for (iter = 0; iter < 2; iter++)
+ {
+ if (iter == 1 && !process_has_separate_stderr (p))
+ break;
+ while ((readstatus = read_process_output (p, iter)) > 0)
;
if (readstatus > 0)
; /* this clauses never gets executed but allows the #ifdefs
@@ -3011,6 +3039,8 @@
|| EQ (status, Qrun))
update_process_status (p, Qexit, 256, 0);
deactivate_process (p);
+ break;
+ }
}
/* We must call status_notify here to allow the
@@ -3884,7 +3914,7 @@
/* This function can GC */
safe_run_hook_trapping_errors
("Error in `pre-command-hook' (setting hook to nil)",
- Qpre_command_hook, 1);
+ Qpre_command_hook, INHIBIT_THROWS);
/* This is a kludge, but necessary; see simple.el */
call0 (Qhandle_pre_motion_command);
@@ -3929,7 +3959,7 @@
safe_run_hook_trapping_errors
("Error in `post-command-hook' (setting hook to nil)",
- Qpost_command_hook, 1);
+ Qpost_command_hook, INHIBIT_THROWS);
#if 0 /* FSF Emacs crap */
if (!NILP (Vdeferred_action_list))
@@ -4532,7 +4562,7 @@
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;
@@ -4549,7 +4579,7 @@
This generally happens as a result of a call to `next-event',
`next-command-event', `sit-for', `sleep-for', `accept-process-output',
`x-get-selection', or various Energize-specific commands.
-Errors running the hook are caught and ignored.
+Errors while running the hook are caught and turned into warnings.
*/ );
Vpre_idle_hook = Qnil;
Index: src/s/windowsnt.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/s/windowsnt.h,v
retrieving revision 1.15.2.13
diff -u -w -r1.15.2.13 windowsnt.h
--- windowsnt.h 2000/03/05 13:49:03 1.15.2.13
+++ windowsnt.h 2000/03/20 12:16:38
@@ -185,6 +185,11 @@
#include <stdio.h>
+#define ENCAPSULATE_STAT
+#define ENCAPSULATE_FSTAT
+int msw_stat (const char * path, struct stat * buf);
+int msw_fstat (int handle, struct stat *buffer);
+
/* subprocess calls that are emulated */
#ifndef DONT_ENCAPSULATE
#define spawnve sys_spawnve
@@ -246,10 +251,10 @@
/* We now have emulation for some signals */
#define HAVE_SIGHOLD
-#define sigset(s,h) msw_sigset(s,h)
-#define sighold(s) msw_sighold(s)
-#define sigrelse(s) msw_sigrelse(s)
-#define sigpause(s) msw_sigpause(s)
+#define sigset(s,h) mswindows_sigset(s,h)
+#define sighold(s) mswindows_sighold(s)
+#define sigrelse(s) mswindows_sigrelse(s)
+#define sigpause(s) mswindows_sigpause(s)
/* Defines that we need that aren't in the standard signal.h */
#define SIGHUP 1 /* Hang up */