Mercurial > hg > xemacs-beta
annotate src/process.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | b5df3737028a |
| children | f965e31a35f0 |
| rev | line source |
|---|---|
| 428 | 1 /* Asynchronous subprocess control for XEmacs. |
| 2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 5125 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 814 | 24 /* This file has been Mule-ized. */ |
| 428 | 25 |
| 26 /* This file has been split into process.c and process-unix.c by | |
| 27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not | |
| 814 | 28 the original author(s). |
| 29 | |
| 30 Non-synch-subprocess stuff (mostly process environment) moved from | |
| 853 | 31 callproc.c, 4-3-02, Ben Wing. |
| 32 | |
| 33 callproc.c deleted entirely 5-23-02, Ben Wing. Good riddance! | |
| 34 */ | |
| 428 | 35 |
| 36 #include <config.h> | |
| 37 | |
| 38 #include "lisp.h" | |
| 39 | |
| 40 #include "buffer.h" | |
| 41 #include "commands.h" | |
| 800 | 42 #include "device.h" |
| 428 | 43 #include "events.h" |
| 800 | 44 #include "file-coding.h" |
| 428 | 45 #include "frame.h" |
| 46 #include "hash.h" | |
| 47 #include "insdel.h" | |
| 48 #include "lstream.h" | |
| 49 #include "opaque.h" | |
| 50 #include "process.h" | |
| 51 #include "procimpl.h" | |
| 816 | 52 #include "sysdep.h" |
| 428 | 53 #include "window.h" |
| 54 | |
| 55 #include "sysfile.h" | |
| 56 #include "sysproc.h" | |
| 859 | 57 #include "syssignal.h" |
| 428 | 58 #include "systime.h" |
| 59 #include "systty.h" | |
| 60 #include "syswait.h" | |
| 61 | |
| 2367 | 62 #ifdef WIN32_NATIVE |
| 63 #include "syswindows.h" | |
| 64 #endif | |
| 65 | |
| 863 | 66 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p; |
| 428 | 67 |
| 68 /* Process methods */ | |
| 69 struct process_methods the_process_methods; | |
| 70 | |
| 71 /* a process object is a network connection when its pid field a cons | |
| 72 (name of name of port we are connected to . foreign host name) */ | |
| 73 | |
| 74 /* Valid values of process->status_symbol */ | |
| 75 Lisp_Object Qrun, Qstop; | |
| 76 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ | |
| 77 Lisp_Object Qopen, Qclosed; | |
| 78 /* Protocol families */ | |
| 79 Lisp_Object Qtcp, Qudp; | |
| 80 | |
| 81 #ifdef HAVE_MULTICAST | |
| 82 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ | |
| 83 #endif | |
| 84 | |
| 85 /* t means use pty, nil means use a pipe, | |
| 86 maybe other values to come. */ | |
| 87 Lisp_Object Vprocess_connection_type; | |
| 88 | |
| 89 /* Read comments to DEFVAR of this */ | |
| 90 int windowed_process_io; | |
| 91 | |
| 92 #ifdef PROCESS_IO_BLOCKING | |
| 93 /* List of port numbers or port names to set a blocking I/O mode. | |
| 94 Nil means set a non-blocking I/O mode [default]. */ | |
| 95 Lisp_Object network_stream_blocking_port_list; | |
| 96 #endif /* PROCESS_IO_BLOCKING */ | |
| 97 | |
| 98 /* Number of events of change of status of a process. */ | |
| 99 volatile int process_tick; | |
| 100 | |
| 101 /* Number of events for which the user or sentinel has been notified. */ | |
| 102 static int update_tick; | |
| 103 | |
| 104 /* Nonzero means delete a process right away if it exits. */ | |
| 105 int delete_exited_processes; | |
| 106 | |
| 853 | 107 /* Hash table which maps USIDs as returned by create_io_streams_cb to |
| 428 | 108 process objects. Processes are not GC-protected through this! */ |
| 109 struct hash_table *usid_to_process; | |
| 110 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
111 /* Read-only to Lisp. See DEFUN Fprocess_list. */ |
| 428 | 112 Lisp_Object Vprocess_list; |
| 113 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
114 /* Lisp variables; see docstrings below. */ |
| 442 | 115 Lisp_Object Vnull_device; |
| 771 | 116 Lisp_Object Vdefault_process_coding_system; |
| 853 | 117 Lisp_Object Vdefault_network_coding_system; |
| 563 | 118 Lisp_Object Qprocess_error; |
| 119 Lisp_Object Qnetwork_error; | |
| 771 | 120 Fixnum debug_process_io; |
| 814 | 121 Lisp_Object Vshell_file_name; |
| 122 Lisp_Object Vprocess_environment; | |
| 123 | |
| 124 /* Make sure egetenv() not called too soon */ | |
| 125 int env_initted; | |
| 126 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
127 /* Internal Lisp variable. */ |
| 814 | 128 Lisp_Object Vlisp_EXEC_SUFFIXES; |
| 129 | |
| 428 | 130 |
| 131 | |
| 1204 | 132 static const struct memory_description process_description [] = { |
| 133 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Process, x) }, | |
| 134 #include "process-slots.h" | |
| 934 | 135 { XD_END } |
| 136 }; | |
| 137 | |
| 428 | 138 static Lisp_Object |
| 444 | 139 mark_process (Lisp_Object object) |
| 428 | 140 { |
| 444 | 141 Lisp_Process *process = XPROCESS (object); |
| 1204 | 142 #define MARKED_SLOT(x) mark_object (process->x); |
| 143 #include "process-slots.h" | |
| 144 return Qnil; | |
| 428 | 145 } |
| 146 | |
| 147 static void | |
| 4846 | 148 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 428 | 149 { |
| 4846 | 150 Lisp_Process *process = XPROCESS (obj); |
| 428 | 151 |
| 152 if (print_readably) | |
| 4846 | 153 printing_unreadable_lcrecord (obj, XSTRING_DATA (process->name)); |
| 428 | 154 |
| 155 if (!escapeflag) | |
| 156 { | |
| 444 | 157 print_internal (process->name, printcharfun, 0); |
| 428 | 158 } |
| 159 else | |
| 160 { | |
| 4846 | 161 int netp = network_connection_p (obj); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
162 write_ascstring (printcharfun, |
| 826 | 163 netp ? GETTEXT ("#<network connection ") : |
| 164 GETTEXT ("#<process ")); | |
| 444 | 165 print_internal (process->name, printcharfun, 1); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
166 write_ascstring (printcharfun, (netp ? " " : " pid ")); |
| 444 | 167 print_internal (process->pid, printcharfun, 1); |
| 800 | 168 write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol); |
| 444 | 169 MAYBE_PROCMETH (print_process_data, (process, printcharfun)); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
170 write_ascstring (printcharfun, ">"); |
| 428 | 171 } |
| 172 } | |
| 173 | |
| 174 #ifdef HAVE_WINDOW_SYSTEM | |
| 440 | 175 extern void debug_process_finalization (Lisp_Process *p); |
| 428 | 176 #endif /* HAVE_WINDOW_SYSTEM */ |
| 177 | |
| 178 static void | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
179 finalize_process (Lisp_Object obj) |
| 428 | 180 { |
| 181 /* #### this probably needs to be tied into the tty event loop */ | |
| 182 /* #### when there is one */ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
183 Lisp_Process *p = XPROCESS (obj); |
| 428 | 184 #ifdef HAVE_WINDOW_SYSTEM |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
185 debug_process_finalization (p); |
| 428 | 186 #endif /* HAVE_WINDOW_SYSTEM */ |
| 187 | |
| 188 if (p->process_data) | |
| 189 { | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
190 MAYBE_PROCMETH (finalize_process_data, (p)); |
| 5125 | 191 xfree (p->process_data); |
| 428 | 192 } |
| 193 } | |
| 194 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
195 DEFINE_NODUMP_LISP_OBJECT ("process", process, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
196 mark_process, print_process, finalize_process, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
197 0, 0, process_description, Lisp_Process); |
| 428 | 198 |
| 199 /************************************************************************/ | |
| 200 /* basic process accessors */ | |
| 201 /************************************************************************/ | |
| 202 | |
| 771 | 203 /* This function returns low-level streams, connected directly to the child |
| 204 process, rather than en/decoding streams */ | |
| 428 | 205 void |
| 853 | 206 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr, |
| 207 Lisp_Object *errstr) | |
| 428 | 208 { |
| 209 assert (p); | |
| 853 | 210 assert (NILP (p->pipe_instream) || LSTREAMP (p->pipe_instream)); |
| 211 assert (NILP (p->pipe_outstream) || LSTREAMP (p->pipe_outstream)); | |
| 212 assert (NILP (p->pipe_errstream) || LSTREAMP (p->pipe_errstream)); | |
| 428 | 213 *instr = p->pipe_instream; |
| 214 *outstr = p->pipe_outstream; | |
| 853 | 215 *errstr = p->pipe_errstream; |
| 428 | 216 } |
| 217 | |
| 853 | 218 /* Given a USID referring to either a process's instream or errstream, |
| 219 return the associated process. */ | |
| 440 | 220 Lisp_Process * |
| 428 | 221 get_process_from_usid (USID usid) |
| 222 { | |
| 442 | 223 const void *vval; |
| 428 | 224 |
| 225 assert (usid != USID_ERROR && usid != USID_DONTHASH); | |
| 226 | |
| 442 | 227 if (gethash ((const void*)usid, usid_to_process, &vval)) |
| 428 | 228 { |
| 444 | 229 Lisp_Object process; |
| 5013 | 230 process = GET_LISP_FROM_VOID (vval); |
| 444 | 231 return XPROCESS (process); |
| 428 | 232 } |
| 233 else | |
| 234 return 0; | |
| 235 } | |
| 236 | |
| 237 int | |
| 853 | 238 get_process_selected_p (Lisp_Process *p, int do_err) |
| 428 | 239 { |
| 853 | 240 return do_err ? p->err_selected : p->in_selected; |
| 428 | 241 } |
| 242 | |
| 243 void | |
| 853 | 244 set_process_selected_p (Lisp_Process *p, int in_selected, int err_selected) |
| 428 | 245 { |
| 853 | 246 p->in_selected = !!in_selected; |
| 247 p->err_selected = !!err_selected; | |
| 428 | 248 } |
| 249 | |
| 250 int | |
| 440 | 251 connected_via_filedesc_p (Lisp_Process *p) |
| 428 | 252 { |
| 253 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); | |
| 254 } | |
| 255 | |
| 256 #ifdef HAVE_SOCKETS | |
| 257 int | |
| 258 network_connection_p (Lisp_Object process) | |
| 259 { | |
| 260 return CONSP (XPROCESS (process)->pid); | |
| 261 } | |
| 262 #endif | |
| 263 | |
| 264 DEFUN ("processp", Fprocessp, 1, 1, 0, /* | |
| 265 Return t if OBJECT is a process. | |
| 266 */ | |
| 444 | 267 (object)) |
| 428 | 268 { |
| 444 | 269 return PROCESSP (object) ? Qt : Qnil; |
| 428 | 270 } |
| 271 | |
| 440 | 272 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* |
| 273 Return t if OBJECT is a process that is alive. | |
| 274 */ | |
| 444 | 275 (object)) |
| 440 | 276 { |
| 444 | 277 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object)) |
| 278 ? Qt : Qnil; | |
| 440 | 279 } |
| 280 | |
| 863 | 281 #if 0 |
| 282 /* This is a reasonable definition for this new primitive. Kyle sez: | |
| 283 | |
| 284 "The patch looks OK to me except for the creation and exporting of the | |
| 285 Fprocess_readable_p function. I don't think a new Lisp function | |
| 286 should be created until we know something actually needs it. If | |
| 287 we later want to give process-readable-p different semantics it | |
| 288 may be hard to do it and stay compatible with what we hastily | |
| 289 create today." | |
| 290 | |
| 291 He's right, not yet. Let's discuss the semantics on XEmacs Design | |
| 292 before enabling this. | |
| 293 */ | |
| 294 DEFUN ("process-readable-p", Fprocess_readable_p, 1, 1, 0, /* | |
| 295 Return t if OBJECT is a process from which input may be available. | |
| 296 */ | |
| 297 (object)) | |
| 298 { | |
| 299 return PROCESSP (object) && PROCESS_READABLE_P (XPROCESS (object)) | |
| 300 ? Qt : Qnil; | |
| 301 } | |
| 302 #endif | |
| 303 | |
| 428 | 304 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* |
| 305 Return a list of all processes. | |
| 306 */ | |
| 307 ()) | |
| 308 { | |
| 309 return Fcopy_sequence (Vprocess_list); | |
| 310 } | |
| 311 | |
| 312 DEFUN ("get-process", Fget_process, 1, 1, 0, /* | |
| 444 | 313 Return the process named PROCESS-NAME (a string), or nil if there is none. |
| 314 PROCESS-NAME may also be a process; if so, the value is that process. | |
| 428 | 315 */ |
| 444 | 316 (process_name)) |
| 428 | 317 { |
| 444 | 318 if (PROCESSP (process_name)) |
| 319 return process_name; | |
| 428 | 320 |
| 321 if (!gc_in_progress) | |
| 322 /* this only gets called during GC when emacs is going away as a result | |
| 323 of a signal or crash. */ | |
| 444 | 324 CHECK_STRING (process_name); |
| 428 | 325 |
| 444 | 326 { |
| 327 LIST_LOOP_2 (process, Vprocess_list) | |
| 328 if (internal_equal (process_name, XPROCESS (process)->name, 0)) | |
| 329 return process; | |
| 330 } | |
| 428 | 331 return Qnil; |
| 332 } | |
| 333 | |
| 334 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* | |
| 335 Return the (or, a) process associated with BUFFER. | |
| 336 BUFFER may be a buffer or the name of one. | |
| 337 */ | |
| 444 | 338 (buffer)) |
| 428 | 339 { |
| 444 | 340 if (NILP (buffer)) return Qnil; |
| 341 buffer = Fget_buffer (buffer); | |
| 342 if (NILP (buffer)) return Qnil; | |
| 428 | 343 |
| 444 | 344 { |
| 345 LIST_LOOP_2 (process, Vprocess_list) | |
| 346 if (EQ (XPROCESS (process)->buffer, buffer)) | |
| 347 return process; | |
| 348 } | |
| 428 | 349 return Qnil; |
| 350 } | |
| 351 | |
| 352 /* This is how commands for the user decode process arguments. It | |
| 353 accepts a process, a process name, a buffer, a buffer name, or nil. | |
| 354 Buffers denote the first process in the buffer, and nil denotes the | |
| 355 current buffer. */ | |
| 356 | |
| 357 static Lisp_Object | |
| 358 get_process (Lisp_Object name) | |
| 359 { | |
| 444 | 360 Lisp_Object buffer; |
| 428 | 361 |
| 362 #ifdef I18N3 | |
| 363 /* #### Look more closely into translating process names. */ | |
| 364 #endif | |
| 365 | |
| 366 /* This may be called during a GC from process_send_signal() from | |
| 2500 | 367 kill_buffer_processes() if emacs decides to ABORT(). */ |
| 428 | 368 if (PROCESSP (name)) |
| 369 return name; | |
| 444 | 370 else if (STRINGP (name)) |
| 428 | 371 { |
| 444 | 372 Lisp_Object object = Fget_process (name); |
| 373 if (PROCESSP (object)) | |
| 374 return object; | |
| 375 | |
| 376 buffer = Fget_buffer (name); | |
| 377 if (BUFFERP (buffer)) | |
| 378 goto have_buffer_object; | |
| 379 | |
| 563 | 380 invalid_argument ("Process does not exist", name); |
| 428 | 381 } |
| 382 else if (NILP (name)) | |
| 444 | 383 { |
| 384 buffer = Fcurrent_buffer (); | |
| 385 goto have_buffer_object; | |
| 386 } | |
| 387 else if (BUFFERP (name)) | |
| 388 { | |
| 389 Lisp_Object process; | |
| 390 buffer = name; | |
| 428 | 391 |
| 444 | 392 have_buffer_object: |
| 393 process = Fget_buffer_process (buffer); | |
| 394 if (PROCESSP (process)) | |
| 395 return process; | |
| 396 | |
| 563 | 397 invalid_argument ("Buffer has no process", buffer); |
| 428 | 398 } |
| 399 else | |
| 444 | 400 return get_process (Fsignal (Qwrong_type_argument, |
| 771 | 401 (list2 (build_msg_string ("process or buffer or nil"), |
| 444 | 402 name)))); |
| 428 | 403 } |
| 404 | |
| 405 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* | |
| 406 Return the process id of PROCESS. | |
| 407 This is the pid of the Unix process which PROCESS uses or talks to. | |
| 408 For a network connection, this value is a cons of | |
| 409 (foreign-network-port . foreign-host-name). | |
| 410 */ | |
| 444 | 411 (process)) |
| 428 | 412 { |
| 413 Lisp_Object pid; | |
| 444 | 414 CHECK_PROCESS (process); |
| 428 | 415 |
| 444 | 416 pid = XPROCESS (process)->pid; |
| 417 if (network_connection_p (process)) | |
| 428 | 418 /* return Qnil; */ |
| 419 return Fcons (Fcar (pid), Fcdr (pid)); | |
| 420 else | |
| 421 return pid; | |
| 422 } | |
| 423 | |
| 424 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* | |
| 425 Return the name of PROCESS, as a string. | |
| 426 This is the name of the program invoked in PROCESS, | |
| 427 possibly modified to make it unique among process names. | |
| 428 */ | |
| 444 | 429 (process)) |
| 428 | 430 { |
| 444 | 431 CHECK_PROCESS (process); |
| 432 return XPROCESS (process)->name; | |
| 428 | 433 } |
| 434 | |
| 435 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* | |
| 436 Return the command that was executed to start PROCESS. | |
| 437 This is a list of strings, the first string being the program executed | |
| 438 and the rest of the strings being the arguments given to it. | |
| 439 */ | |
| 444 | 440 (process)) |
| 428 | 441 { |
| 444 | 442 CHECK_PROCESS (process); |
| 443 return XPROCESS (process)->command; | |
| 428 | 444 } |
| 445 | |
| 446 | |
| 447 /************************************************************************/ | |
| 448 /* creating a process */ | |
| 449 /************************************************************************/ | |
| 450 | |
| 563 | 451 DOESNT_RETURN |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
452 report_process_error (const Ascbyte *reason, Lisp_Object data) |
| 563 | 453 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
454 report_error_with_errno (Qprocess_error, reason, data); |
| 563 | 455 } |
| 456 | |
| 457 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
458 report_network_error (const Ascbyte *reason, Lisp_Object data) |
| 563 | 459 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
460 report_error_with_errno (Qnetwork_error, reason, data); |
| 563 | 461 } |
| 462 | |
| 428 | 463 Lisp_Object |
| 464 make_process_internal (Lisp_Object name) | |
| 465 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
466 Lisp_Object name1; |
| 428 | 467 int i; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
468 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (process); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
469 Lisp_Process *p = XPROCESS (obj); |
| 428 | 470 |
| 1204 | 471 #define MARKED_SLOT(x) p->x = Qnil; |
| 472 #include "process-slots.h" | |
| 473 | |
| 428 | 474 /* If name is already in use, modify it until it is unused. */ |
| 475 name1 = name; | |
| 476 for (i = 1; ; i++) | |
| 477 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
478 Ascbyte suffix[10]; |
| 428 | 479 Lisp_Object tem = Fget_process (name1); |
| 480 if (NILP (tem)) | |
| 481 break; | |
| 482 sprintf (suffix, "<%d>", i); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
483 name1 = concat2 (name, build_ascstring (suffix)); |
| 428 | 484 } |
| 485 name = name1; | |
| 486 p->name = name; | |
| 487 | |
| 488 p->mark = Fmake_marker (); | |
| 853 | 489 p->stderr_mark = Fmake_marker (); |
| 428 | 490 p->status_symbol = Qrun; |
| 491 | |
| 492 MAYBE_PROCMETH (alloc_process_data, (p)); | |
| 493 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
494 Vprocess_list = Fcons (obj, Vprocess_list); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
495 return obj; |
| 428 | 496 } |
| 497 | |
| 498 void | |
| 853 | 499 init_process_io_handles (Lisp_Process *p, void* in, void* out, void* err, |
| 500 int flags) | |
| 428 | 501 { |
| 853 | 502 USID in_usid, err_usid; |
| 771 | 503 Lisp_Object incode, outcode; |
| 504 | |
| 853 | 505 if (flags & STREAM_NETWORK_CONNECTION) |
| 506 { | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
507 if (!LISTP (Vdefault_network_coding_system) || |
| 853 | 508 NILP (incode = (find_coding_system_for_text_file |
| 509 (Fcar (Vdefault_network_coding_system), 1))) || | |
| 510 NILP (outcode = (find_coding_system_for_text_file | |
| 511 (Fcdr (Vdefault_network_coding_system), 0)))) | |
| 512 signal_error (Qinvalid_state, | |
| 513 "Bogus value for `default-network-coding-system'", | |
| 514 Vdefault_network_coding_system); | |
| 515 } | |
| 516 else | |
| 517 { | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
518 if (!LISTP (Vdefault_process_coding_system) || |
| 853 | 519 NILP (incode = (find_coding_system_for_text_file |
| 520 (Fcar (Vdefault_process_coding_system), 1))) || | |
| 521 NILP (outcode = (find_coding_system_for_text_file | |
| 522 (Fcdr (Vdefault_process_coding_system), 0)))) | |
| 523 signal_error (Qinvalid_state, | |
| 524 "Bogus value for `default-process-coding-system'", | |
| 525 Vdefault_process_coding_system); | |
| 526 } | |
| 771 | 527 |
| 784 | 528 if (!NILP (Vcoding_system_for_read) && |
| 529 NILP (incode = (find_coding_system_for_text_file | |
| 530 (Vcoding_system_for_read, 1)))) | |
| 531 signal_error (Qinvalid_state, | |
| 532 "Bogus value for `coding-system-for-read'", | |
| 533 Vcoding_system_for_read); | |
| 534 | |
| 535 if (!NILP (Vcoding_system_for_write) && | |
| 536 NILP (outcode = (find_coding_system_for_text_file | |
| 537 (Vcoding_system_for_write, 0)))) | |
| 538 signal_error (Qinvalid_state, | |
| 539 "Bogus value for `coding-system-for-write'", | |
| 540 Vcoding_system_for_write); | |
| 541 | |
| 853 | 542 event_stream_create_io_streams (in, out, err, |
| 543 &p->pipe_instream, | |
| 544 &p->pipe_outstream, | |
| 545 &p->pipe_errstream, | |
| 546 &in_usid, &err_usid, | |
| 547 flags); | |
| 428 | 548 |
| 853 | 549 if (in_usid == USID_ERROR || err_usid == USID_ERROR) |
| 563 | 550 signal_error (Qprocess_error, "Setting up communication with subprocess", |
| 853 | 551 wrap_process (p)); |
| 428 | 552 |
| 853 | 553 if (in_usid != USID_DONTHASH) |
| 428 | 554 { |
| 444 | 555 Lisp_Object process = Qnil; |
| 793 | 556 process = wrap_process (p); |
| 5013 | 557 puthash ((const void*) in_usid, STORE_LISP_IN_VOID (process), usid_to_process); |
| 428 | 558 } |
| 559 | |
| 853 | 560 if (err_usid != USID_DONTHASH) |
| 561 { | |
| 562 Lisp_Object process = Qnil; | |
| 563 process = wrap_process (p); | |
| 5013 | 564 puthash ((const void*) err_usid, STORE_LISP_IN_VOID (process), |
| 853 | 565 usid_to_process); |
| 566 } | |
| 567 | |
| 568 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, err, flags)); | |
| 428 | 569 |
| 771 | 570 p->coding_instream = |
| 800 | 571 make_coding_input_stream (XLSTREAM (p->pipe_instream), incode, |
| 572 CODING_DECODE, 0); | |
| 853 | 573 if (!NILP (p->pipe_errstream)) |
| 574 p->coding_errstream = | |
| 575 make_coding_input_stream | |
| 576 (XLSTREAM (p->pipe_errstream), incode, CODING_DECODE, 0); | |
| 771 | 577 p->coding_outstream = |
| 800 | 578 make_coding_output_stream (XLSTREAM (p->pipe_outstream), outcode, |
| 579 CODING_ENCODE, 0); | |
| 428 | 580 } |
| 581 | |
| 582 static void | |
| 583 create_process (Lisp_Object process, Lisp_Object *argv, int nargv, | |
| 853 | 584 Lisp_Object program, Lisp_Object cur_dir, |
| 585 int separate_err) | |
| 428 | 586 { |
| 440 | 587 Lisp_Process *p = XPROCESS (process); |
| 428 | 588 int pid; |
| 589 | |
| 590 /* *_create_process may change status_symbol, if the process | |
| 591 is a kind of "fire-and-forget" (no I/O, unwaitable) */ | |
| 592 p->status_symbol = Qrun; | |
| 593 p->exit_code = 0; | |
| 594 | |
| 853 | 595 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir, |
| 596 separate_err)); | |
| 428 | 597 |
| 598 p->pid = make_int (pid); | |
| 863 | 599 if (PROCESS_READABLE_P (p)) |
| 853 | 600 event_stream_select_process (p, 1, 1); |
| 428 | 601 } |
| 602 | |
| 603 /* This function is the unwind_protect form for Fstart_process_internal. If | |
| 444 | 604 PROCESS doesn't have its pid set, then we know someone has signalled |
| 428 | 605 an error and the process wasn't started successfully, so we should |
| 606 remove it from the process list. */ | |
| 444 | 607 static void remove_process (Lisp_Object process); |
| 428 | 608 static Lisp_Object |
| 444 | 609 start_process_unwind (Lisp_Object process) |
| 428 | 610 { |
| 444 | 611 /* Was PROCESS started successfully? */ |
| 612 if (EQ (XPROCESS (process)->pid, Qnil)) | |
| 613 remove_process (process); | |
| 428 | 614 return Qnil; |
| 615 } | |
| 616 | |
| 617 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* | |
| 853 | 618 Internal function to start a program in a subprocess. |
| 619 Lisp callers should use `start-process' instead. | |
| 620 | |
| 621 Returns the process object for it. | |
| 428 | 622 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS |
| 623 NAME is name for process. It is modified if necessary to make it unique. | |
| 624 BUFFER is the buffer or (buffer-name) to associate with the process. | |
| 625 Process output goes at end of that buffer, unless you specify | |
| 626 an output stream or filter function to handle the output. | |
| 627 BUFFER may be also nil, meaning that this process is not associated | |
| 853 | 628 with any buffer. |
| 629 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
| 630 REAL-BUFFER says what to do with standard output, as above, | |
| 631 while STDERR-BUFFER says what to do with standard error in the child. | |
| 632 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
| 633 filter is set). Note that if you do not use this form at process creation, | |
| 634 stdout and stderr will be mixed in the output buffer, and this cannot be | |
| 635 changed, even by setting a stderr filter. | |
| 428 | 636 Third arg is program file name. It is searched for as in the shell. |
| 637 Remaining arguments are strings to give program as arguments. | |
| 853 | 638 |
| 639 Read and write coding systems for the process are determined from | |
| 640 `coding-system-for-read' and `coding-system-for-write' (intended as | |
| 641 overriding coding systems to be *bound* by Lisp code, not set), or | |
| 642 from `default-process-coding-system' if either or both are nil. You can | |
| 643 change the coding systems later on using `set-process-coding-system', | |
| 644 `set-process-input-coding-system', or `set-process-output-coding-system'. | |
| 645 | |
| 646 See also `set-process-filter' and `set-process-stderr-filter'. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
647 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
648 arguments: (NAME BUFFER PROGRAM &rest PROGRAM-ARGS) |
| 428 | 649 */ |
| 650 (int nargs, Lisp_Object *args)) | |
| 651 { | |
| 652 /* This function can call lisp */ | |
| 853 | 653 Lisp_Object buffer, stderr_buffer, name, program, process, current_dir; |
| 654 int separate_stderr; | |
| 428 | 655 Lisp_Object tem; |
| 910 | 656 int i; |
| 428 | 657 int speccount = specpdl_depth (); |
| 658 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 659 | |
| 660 name = args[0]; | |
| 661 buffer = args[1]; | |
| 662 program = args[2]; | |
| 663 current_dir = Qnil; | |
| 664 | |
| 665 /* Protect against various file handlers doing GCs below. */ | |
| 666 GCPRO3 (buffer, program, current_dir); | |
| 667 | |
| 853 | 668 if (CONSP (buffer)) |
| 669 { | |
| 670 if (!CONSP (XCDR (buffer))) | |
| 671 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
| 672 buffer); | |
| 673 if (!NILP (XCDR (XCDR (buffer)))) | |
| 674 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
| 675 buffer); | |
| 676 stderr_buffer = XCAR (XCDR (buffer)); | |
| 677 buffer = XCAR (buffer); | |
| 678 separate_stderr = 1; | |
| 679 } | |
| 680 else | |
| 681 { | |
| 682 stderr_buffer = Qnil; | |
| 683 separate_stderr = 0; | |
| 684 } | |
| 685 | |
| 428 | 686 if (!NILP (buffer)) |
| 687 buffer = Fget_buffer_create (buffer); | |
| 853 | 688 if (!NILP (stderr_buffer)) |
| 689 stderr_buffer = Fget_buffer_create (stderr_buffer); | |
| 428 | 690 |
| 691 CHECK_STRING (name); | |
| 692 CHECK_STRING (program); | |
| 910 | 693 for (i = 3; i < nargs; ++i) |
| 694 CHECK_STRING (args[i]); | |
| 428 | 695 |
| 696 /* Make sure that the child will be able to chdir to the current | |
| 502 | 697 buffer's current directory, or its unhandled equivalent. [[ We |
| 428 | 698 can't just have the child check for an error when it does the |
| 502 | 699 chdir, since it's in a vfork. ]] -- not any more, we don't use |
| 700 vfork. -ben | |
| 428 | 701 |
| 502 | 702 Note: These calls are spread out to insure that the return values |
| 703 of the calls (which may be newly-created strings) are properly | |
| 704 GC-protected. */ | |
| 428 | 705 current_dir = current_buffer->directory; |
| 502 | 706 /* If the current dir has no terminating slash, we'll get undesirable |
| 707 results, so put the slash back. */ | |
| 708 current_dir = Ffile_name_as_directory (current_dir); | |
| 428 | 709 current_dir = Funhandled_file_name_directory (current_dir); |
| 710 current_dir = expand_and_dir_to_file (current_dir, Qnil); | |
| 711 | |
| 712 #if 0 /* This loser breaks ange-ftp */ | |
| 713 /* dmoore - if you re-enable this code, you have to gcprotect | |
| 714 current_buffer through the above calls. */ | |
| 715 if (NILP (Ffile_accessible_directory_p (current_dir))) | |
| 563 | 716 signal_error (Qprocess_error, "Setting current directory", |
| 717 current_buffer->directory); | |
| 428 | 718 #endif /* 0 */ |
| 719 | |
| 720 /* If program file name is not absolute, search our path for it */ | |
| 826 | 721 if (!IS_DIRECTORY_SEP (string_byte (program, 0)) |
| 428 | 722 && !(XSTRING_LENGTH (program) > 1 |
| 826 | 723 && IS_DEVICE_SEP (string_byte (program, 1)))) |
| 428 | 724 { |
| 725 struct gcpro ngcpro1; | |
| 726 | |
| 727 tem = Qnil; | |
| 728 NGCPRO1 (tem); | |
| 729 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); | |
| 730 if (NILP (tem)) | |
| 563 | 731 signal_error (Qprocess_error, "Searching for program", program); |
| 428 | 732 program = Fexpand_file_name (tem, Qnil); |
| 733 NUNGCPRO; | |
| 734 } | |
| 735 else | |
| 736 { | |
| 442 | 737 /* we still need to canonicalize it and ensure it has the proper |
| 738 ending, e.g. .exe */ | |
| 739 struct gcpro ngcpro1; | |
| 740 | |
| 741 tem = Qnil; | |
| 742 NGCPRO1 (tem); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
743 locate_file (list1 (build_ascstring ("")), program, Vlisp_EXEC_SUFFIXES, |
| 442 | 744 &tem, X_OK); |
| 745 if (NILP (tem)) | |
| 563 | 746 signal_error (Qprocess_error, "Searching for program", program); |
| 442 | 747 program = tem; |
| 748 NUNGCPRO; | |
| 428 | 749 } |
| 750 | |
| 442 | 751 if (!NILP (Ffile_directory_p (program))) |
| 752 invalid_operation ("Specified program for new process is a directory", | |
| 753 program); | |
| 754 | |
| 444 | 755 process = make_process_internal (name); |
| 428 | 756 |
| 444 | 757 XPROCESS (process)->buffer = buffer; |
| 853 | 758 XPROCESS (process)->stderr_buffer = stderr_buffer; |
| 759 XPROCESS (process)->separate_stderr = separate_stderr; | |
| 814 | 760 XPROCESS (process)->command = Flist (nargs - 2, args + 2); |
| 428 | 761 |
| 762 /* Make the process marker point into the process buffer (if any). */ | |
| 763 if (!NILP (buffer)) | |
| 444 | 764 Fset_marker (XPROCESS (process)->mark, |
| 428 | 765 make_int (BUF_ZV (XBUFFER (buffer))), buffer); |
| 853 | 766 if (!NILP (stderr_buffer)) |
| 767 Fset_marker (XPROCESS (process)->stderr_mark, | |
| 768 make_int (BUF_ZV (XBUFFER (stderr_buffer))), stderr_buffer); | |
| 428 | 769 |
| 770 /* If an error occurs and we can't start the process, we want to | |
| 771 remove it from the process list. This means that each error | |
| 772 check in create_process doesn't need to call remove_process | |
| 773 itself; it's all taken care of here. */ | |
| 444 | 774 record_unwind_protect (start_process_unwind, process); |
| 428 | 775 |
| 853 | 776 create_process (process, args + 3, nargs - 3, program, current_dir, |
| 777 separate_stderr); | |
| 428 | 778 |
| 779 UNGCPRO; | |
| 771 | 780 return unbind_to_1 (speccount, process); |
| 428 | 781 } |
| 782 | |
| 783 | |
| 784 #ifdef HAVE_SOCKETS | |
| 785 | |
| 786 | |
| 787 /* #### The network support is fairly synthetical. What we actually | |
| 788 need is a single function, which supports all datagram, stream and | |
| 789 packet stream connections, arbitrary protocol families should they | |
| 790 be supported by the target system, multicast groups, in both data | |
| 791 and control rooted/nonrooted flavors, service quality etc whatever | |
| 792 is supported by the underlying network. | |
| 793 | |
| 794 It must accept a property list describing the connection. The current | |
| 795 functions must then go to lisp and provide a suitable list for the | |
| 796 generalized connection function. | |
| 797 | |
| 798 Both UNIX and Win32 support BSD sockets, and there are many extensions | |
| 799 available (Sockets 2 spec). | |
| 800 | |
| 801 A todo is define a consistent set of properties abstracting a | |
| 802 network connection. -kkm | |
| 803 */ | |
| 804 | |
| 805 | |
| 806 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
| 807 exactly like a normal process when reading and writing. Only | |
| 808 differences are in status display and process deletion. A network | |
| 809 connection has no PID; you cannot signal it. All you can do is | |
| 810 deactivate and close it via delete-process */ | |
| 811 | |
| 442 | 812 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, |
| 813 0, /* | |
| 428 | 814 Open a TCP connection for a service to a host. |
| 444 | 815 Return a process object to represent the connection. |
| 428 | 816 Input and output work as for subprocesses; `delete-process' closes it. |
| 817 | |
| 818 NAME is name for process. It is modified if necessary to make it unique. | |
| 819 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 820 Process output goes at end of that buffer, unless you specify | |
| 821 an output stream or filter function to handle the output. | |
| 822 BUFFER may also be nil, meaning that this process is not associated | |
| 823 with any buffer. | |
| 444 | 824 Third arg HOST (a string) is the name of the host to connect to, |
| 825 or its IP address. | |
| 826 Fourth arg SERVICE is the name of the service desired (a string), | |
| 827 or an integer specifying a port number to connect to. | |
| 3025 | 828 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' |
| 829 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are | |
| 830 supported. When omitted, `tcp' is assumed. | |
| 428 | 831 |
| 442 | 832 Output via `process-send-string' and input via buffer or filter (see |
| 428 | 833 `set-process-filter') are stream-oriented. That means UDP datagrams are |
| 834 not guaranteed to be sent and received in discrete packets. (But small | |
| 835 datagrams around 500 bytes that are not truncated by `process-send-string' | |
| 444 | 836 are usually fine.) Note further that the UDP protocol does not guard |
| 837 against lost packets. | |
| 428 | 838 */ |
| 839 (name, buffer, host, service, protocol)) | |
| 840 { | |
| 841 /* This function can GC */ | |
| 444 | 842 Lisp_Object process = Qnil; |
| 428 | 843 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; |
| 844 void *inch, *outch; | |
| 845 | |
| 846 GCPRO5 (name, buffer, host, service, protocol); | |
| 847 CHECK_STRING (name); | |
| 848 | |
| 771 | 849 if (NILP (protocol)) |
| 428 | 850 protocol = Qtcp; |
| 851 else | |
| 852 CHECK_SYMBOL (protocol); | |
| 853 | |
| 854 /* Since this code is inside HAVE_SOCKETS, existence of | |
| 855 open_network_stream is mandatory */ | |
| 856 PROCMETH (open_network_stream, (name, host, service, protocol, | |
| 857 &inch, &outch)); | |
| 858 | |
| 859 if (!NILP (buffer)) | |
| 860 buffer = Fget_buffer_create (buffer); | |
| 444 | 861 process = make_process_internal (name); |
| 862 NGCPRO1 (process); | |
| 428 | 863 |
| 444 | 864 XPROCESS (process)->pid = Fcons (service, host); |
| 865 XPROCESS (process)->buffer = buffer; | |
| 771 | 866 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
| 853 | 867 (void *) -1, |
| 428 | 868 STREAM_NETWORK_CONNECTION); |
| 869 | |
| 853 | 870 event_stream_select_process (XPROCESS (process), 1, 1); |
| 428 | 871 |
| 1204 | 872 NUNGCPRO; |
| 428 | 873 UNGCPRO; |
| 444 | 874 return process; |
| 428 | 875 } |
| 876 | |
| 877 #ifdef HAVE_MULTICAST | |
| 878 | |
| 879 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* | |
| 880 Open a multicast connection on the specified dest/port/ttl. | |
| 444 | 881 Return a process object to represent the connection. |
| 428 | 882 Input and output work as for subprocesses; `delete-process' closes it. |
| 883 | |
| 884 NAME is name for process. It is modified if necessary to make it unique. | |
| 885 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 886 Process output goes at end of that buffer, unless you specify | |
| 887 an output stream or filter function to handle the output. | |
| 888 BUFFER may also be nil, meaning that this process is not associated | |
| 889 with any buffer. | |
| 890 Third, fourth and fifth args are the multicast destination group, port and ttl. | |
| 891 dest must be an internet address between 224.0.0.0 and 239.255.255.255 | |
| 892 port is a communication port like in traditional unicast | |
| 893 ttl is the time-to-live (15 for site, 63 for region and 127 for world) | |
| 894 */ | |
| 895 (name, buffer, dest, port, ttl)) | |
| 896 { | |
| 897 /* This function can GC */ | |
| 444 | 898 Lisp_Object process = Qnil; |
| 428 | 899 struct gcpro gcpro1; |
| 900 void *inch, *outch; | |
| 901 | |
| 902 CHECK_STRING (name); | |
| 903 | |
| 904 /* Since this code is inside HAVE_MULTICAST, existence of | |
| 771 | 905 open_multicast_group is mandatory */ |
| 428 | 906 PROCMETH (open_multicast_group, (name, dest, port, ttl, |
| 907 &inch, &outch)); | |
| 908 | |
| 909 if (!NILP (buffer)) | |
| 910 buffer = Fget_buffer_create (buffer); | |
| 911 | |
| 444 | 912 process = make_process_internal (name); |
| 913 GCPRO1 (process); | |
| 428 | 914 |
| 444 | 915 XPROCESS (process)->pid = Fcons (port, dest); |
| 916 XPROCESS (process)->buffer = buffer; | |
| 853 | 917 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
| 918 (void *) -1, | |
| 428 | 919 STREAM_NETWORK_CONNECTION); |
| 920 | |
| 853 | 921 event_stream_select_process (XPROCESS (process), 1, 1); |
| 428 | 922 |
| 923 UNGCPRO; | |
| 444 | 924 return process; |
| 428 | 925 } |
| 926 #endif /* HAVE_MULTICAST */ | |
| 927 | |
| 928 #endif /* HAVE_SOCKETS */ | |
| 929 | |
| 930 Lisp_Object | |
| 931 canonicalize_host_name (Lisp_Object host) | |
| 932 { | |
| 933 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); | |
| 934 } | |
| 935 | |
| 936 | |
| 937 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* | |
| 938 Tell PROCESS that it has logical window size HEIGHT and WIDTH. | |
| 939 */ | |
| 444 | 940 (process, height, width)) |
| 428 | 941 { |
| 444 | 942 CHECK_PROCESS (process); |
| 428 | 943 CHECK_NATNUM (height); |
| 944 CHECK_NATNUM (width); | |
| 945 return | |
| 444 | 946 MAYBE_INT_PROCMETH (set_window_size, |
| 947 (XPROCESS (process), XINT (height), XINT (width))) <= 0 | |
| 428 | 948 ? Qnil : Qt; |
| 949 } | |
| 950 | |
| 951 | |
| 952 /************************************************************************/ | |
| 953 /* Process I/O */ | |
| 954 /************************************************************************/ | |
| 955 | |
| 844 | 956 /* Set up PROCESS's buffer for insertion of process data at PROCESS's |
| 957 mark. | |
| 958 | |
| 959 Sets the current buffer to PROCESS's buffer, inhibits read only, | |
| 960 remembers current point, sets point to PROCESS'S mark, widens if | |
| 961 necessary. | |
| 962 */ | |
| 963 static int | |
| 853 | 964 process_setup_for_insertion (Lisp_Object process, int read_stderr) |
| 844 | 965 { |
| 966 Lisp_Process *p = XPROCESS (process); | |
| 967 int spec = specpdl_depth (); | |
| 853 | 968 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; |
| 969 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
| 970 struct buffer *buf = XBUFFER (buffer); | |
| 844 | 971 Charbpos output_pt; |
| 972 | |
| 973 if (buf != current_buffer) | |
| 974 { | |
| 975 record_unwind_protect (save_current_buffer_restore, | |
| 976 Fcurrent_buffer ()); | |
| 977 set_buffer_internal (buf); | |
| 978 } | |
| 979 | |
| 980 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
| 981 specbind (Qinhibit_read_only, Qt); | |
| 854 | 982 |
| 844 | 983 /* Insert new output into buffer |
| 984 at the current end-of-output marker, | |
| 985 thus preserving logical ordering of input and output. */ | |
| 853 | 986 if (XMARKER (mark)->buffer) |
| 987 output_pt = marker_position (mark); | |
| 844 | 988 else |
| 989 output_pt = BUF_ZV (buf); | |
| 990 | |
| 991 /* If the output marker is outside of the visible region, save | |
| 992 the restriction and widen. */ | |
| 993 if (! (BUF_BEGV (buf) <= output_pt && output_pt <= BUF_ZV (buf))) | |
| 994 { | |
| 995 record_unwind_protect (save_restriction_restore, | |
| 996 save_restriction_save (buf)); | |
| 997 Fwiden (wrap_buffer (buf)); | |
| 998 } | |
| 999 | |
| 1000 BUF_SET_PT (buf, output_pt); | |
| 1001 return spec; | |
| 1002 } | |
| 1003 | |
| 428 | 1004 /* Read pending output from the process channel, |
| 1005 starting with our buffered-ahead character if we have one. | |
| 1006 Yield number of characters read. | |
| 1007 | |
| 1008 This function reads at most 1024 bytes. | |
| 1009 If you want to read all available subprocess output, | |
| 1010 you must call it repeatedly until it returns zero. */ | |
| 1011 | |
| 1012 Charcount | |
| 853 | 1013 read_process_output (Lisp_Object process, int read_stderr) |
| 428 | 1014 { |
| 1015 /* This function can GC */ | |
| 1016 Bytecount nbytes, nchars; | |
| 867 | 1017 Ibyte chars[1025]; |
| 428 | 1018 Lisp_Object outstream; |
| 444 | 1019 Lisp_Process *p = XPROCESS (process); |
| 853 | 1020 Lisp_Object filter = read_stderr ? p->stderr_filter : p->filter; |
| 1021 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; | |
| 1022 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
| 428 | 1023 |
| 1024 /* If there is a lot of output from the subprocess, the loop in | |
| 1025 execute_internal_event() might call read_process_output() more | |
| 1026 than once. If the filter that was executed from one of these | |
| 1027 calls set the filter to t, we have to stop now. Return -1 rather | |
| 1028 than 0 so execute_internal_event() doesn't close the process. | |
| 1029 Really, the loop in execute_internal_event() should check itself | |
| 1030 for a process-filter change, like in status_notify(); but the | |
| 1031 struct Lisp_Process is not exported outside of this file. */ | |
| 863 | 1032 if (!PROCESS_READABLE_P (p)) |
| 853 | 1033 { |
| 1034 errno = 0; | |
| 1035 return -1; /* already closed */ | |
| 1036 } | |
| 428 | 1037 |
| 853 | 1038 if (!NILP (filter) && (p->filter_does_read)) |
| 428 | 1039 { |
| 1040 Lisp_Object filter_result; | |
| 1041 | |
| 1042 /* Some weird FSFmacs crap here with | |
| 853 | 1043 Vdeactivate_mark and current_buffer->keymap. |
| 1044 Some FSF junk with running_asynch_code, to preserve the match | |
| 1045 data. Not necessary because we don't call process filters | |
| 1046 asynchronously (i.e. from within QUIT). */ | |
| 1047 /* Don't catch errors here; we're not in any critical code. */ | |
| 1048 filter_result = call2 (filter, process, Qnil); | |
| 428 | 1049 CHECK_INT (filter_result); |
| 1050 return XINT (filter_result); | |
| 1051 } | |
| 1052 | |
| 853 | 1053 nbytes = Lstream_read (read_stderr ? XLSTREAM (DATA_ERRSTREAM (p)) : |
| 1054 XLSTREAM (DATA_INSTREAM (p)), chars, | |
| 771 | 1055 sizeof (chars) - 1); |
| 428 | 1056 if (nbytes <= 0) return nbytes; |
| 1057 | |
| 771 | 1058 if (debug_process_io) |
| 1059 { | |
| 1060 chars[nbytes] = '\0'; | |
| 1061 stderr_out ("Read: %s\n", chars); | |
| 1062 } | |
| 1063 | |
| 1064 /* !!#### if the coding system changed as a result of reading, we | |
| 1065 need to change the output coding system accordingly. */ | |
| 428 | 1066 nchars = bytecount_to_charcount (chars, nbytes); |
| 853 | 1067 outstream = filter; |
| 428 | 1068 if (!NILP (outstream)) |
| 1069 { | |
| 853 | 1070 /* Some FSF junk with running_asynch_code, to preserve the match |
| 1071 data. Not necessary because we don't call process filters | |
| 1072 asynchronously (i.e. from within QUIT). */ | |
| 1073 /* Don't catch errors here; we're not in any critical code. */ | |
| 1074 call2 (outstream, process, make_string (chars, nbytes)); | |
| 428 | 1075 return nchars; |
| 1076 } | |
| 1077 | |
| 1078 /* If no filter, write into buffer if it isn't dead. */ | |
| 853 | 1079 if (!NILP (buffer) && BUFFER_LIVE_P (XBUFFER (buffer))) |
| 428 | 1080 { |
| 844 | 1081 struct gcpro gcpro1; |
| 853 | 1082 struct buffer *buf = XBUFFER (buffer); |
| 1083 int spec = process_setup_for_insertion (process, read_stderr); | |
| 428 | 1084 |
| 844 | 1085 GCPRO1 (process); |
| 428 | 1086 |
| 1087 #if 0 | |
| 1088 /* This screws up initial display of the window. jla */ | |
| 1089 | |
| 1090 /* Insert before markers in case we are inserting where | |
| 1091 the buffer's mark is, and the user's next command is Meta-y. */ | |
| 1092 buffer_insert_raw_string_1 (buf, -1, chars, | |
| 1093 nbytes, INSDEL_BEFORE_MARKERS); | |
| 1094 #else | |
| 1095 buffer_insert_raw_string (buf, chars, nbytes); | |
| 1096 #endif | |
| 1097 | |
| 853 | 1098 Fset_marker (mark, make_int (BUF_PT (buf)), buffer); |
| 1099 | |
| 428 | 1100 MARK_MODELINE_CHANGED; |
| 844 | 1101 unbind_to (spec); |
| 428 | 1102 UNGCPRO; |
| 1103 } | |
| 1104 return nchars; | |
| 1105 } | |
| 853 | 1106 |
| 1107 int | |
| 1108 process_has_separate_stderr (Lisp_Object process) | |
| 1109 { | |
| 1110 return XPROCESS (process)->separate_stderr; | |
| 1111 } | |
| 1112 | |
| 859 | 1113 DEFUN ("process-has-separate-stderr-p", Fprocess_has_separate_stderr_p, 1, 1, |
| 1114 0, /* | |
| 1115 Return non-nil if process has stderr separate from stdout. | |
| 1116 */ | |
| 1117 (process)) | |
| 1118 { | |
| 1119 CHECK_PROCESS (process); | |
| 1120 return process_has_separate_stderr (process) ? Qt : Qnil; | |
| 1121 } | |
| 1122 | |
| 428 | 1123 |
| 1124 /* Sending data to subprocess */ | |
| 1125 | |
| 444 | 1126 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it |
| 428 | 1127 specifies the address of the data. Otherwise, the data comes from the |
| 1128 object RELOCATABLE (either a string or a buffer). START and LEN | |
| 1129 specify the offset and length of the data to send. | |
| 1130 | |
| 665 | 1131 Note that START and LEN are in Charbpos's if RELOCATABLE is a buffer, |
| 428 | 1132 and in Bytecounts otherwise. */ |
| 1133 | |
| 1134 void | |
| 444 | 1135 send_process (Lisp_Object process, |
| 867 | 1136 Lisp_Object relocatable, const Ibyte *nonrelocatable, |
| 428 | 1137 int start, int len) |
| 1138 { | |
| 1139 /* This function can GC */ | |
| 1140 struct gcpro gcpro1, gcpro2; | |
| 1141 Lisp_Object lstream = Qnil; | |
| 1142 | |
| 444 | 1143 GCPRO2 (process, lstream); |
| 428 | 1144 |
| 444 | 1145 if (NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
| 563 | 1146 invalid_operation ("Process not open for writing", process); |
| 428 | 1147 |
| 1148 if (nonrelocatable) | |
| 1149 lstream = | |
| 1150 make_fixed_buffer_input_stream (nonrelocatable + start, len); | |
| 1151 else if (BUFFERP (relocatable)) | |
| 1152 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), | |
| 1153 start, start + len, 0); | |
| 1154 else | |
| 1155 lstream = make_lisp_string_input_stream (relocatable, start, len); | |
| 1156 | |
| 771 | 1157 if (debug_process_io) |
| 1158 { | |
| 1159 if (nonrelocatable) | |
| 1160 stderr_out ("Writing: %s\n", nonrelocatable); | |
| 1161 else | |
| 1162 { | |
| 1163 stderr_out ("Writing: "); | |
| 1164 print_internal (relocatable, Qexternal_debugging_output, 0); | |
| 1165 } | |
| 1166 } | |
| 1167 | |
| 444 | 1168 PROCMETH (send_process, (process, XLSTREAM (lstream))); |
| 428 | 1169 |
| 1170 UNGCPRO; | |
| 1171 Lstream_delete (XLSTREAM (lstream)); | |
| 1172 } | |
| 1173 | |
| 1174 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* | |
| 1175 Return the name of the terminal PROCESS uses, or nil if none. | |
| 1176 This is the terminal that the process itself reads and writes on, | |
| 1177 not the name of the pty that Emacs uses to talk with that terminal. | |
| 1178 */ | |
| 444 | 1179 (process)) |
| 428 | 1180 { |
| 444 | 1181 CHECK_PROCESS (process); |
| 1204 | 1182 return XPROCESS (process)->tty_name; |
| 428 | 1183 } |
| 1184 | |
| 1185 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* | |
| 1186 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). | |
| 2297 | 1187 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
| 428 | 1188 */ |
| 444 | 1189 (process, buffer)) |
| 428 | 1190 { |
| 444 | 1191 CHECK_PROCESS (process); |
| 428 | 1192 if (!NILP (buffer)) |
| 1193 CHECK_BUFFER (buffer); | |
| 444 | 1194 XPROCESS (process)->buffer = buffer; |
| 428 | 1195 return buffer; |
| 1196 } | |
| 1197 | |
| 1198 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* | |
| 1199 Return the buffer PROCESS is associated with. | |
| 2297 | 1200 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
| 1201 Set the buffer with `set-process-buffer'. | |
| 428 | 1202 */ |
| 444 | 1203 (process)) |
| 428 | 1204 { |
| 444 | 1205 CHECK_PROCESS (process); |
| 1206 return XPROCESS (process)->buffer; | |
| 428 | 1207 } |
| 1208 | |
| 853 | 1209 DEFUN ("set-process-stderr-buffer", Fset_process_stderr_buffer, 2, 2, 0, /* |
| 2297 | 1210 Output from the stderr of PROCESS is inserted in this buffer unless |
| 1211 PROCESS has a stderr filter. | |
| 853 | 1212 Set stderr buffer associated with PROCESS to BUFFER (a buffer, or nil). |
| 1213 */ | |
| 1214 (process, buffer)) | |
| 1215 { | |
| 1216 CHECK_PROCESS (process); | |
| 1217 if (!XPROCESS (process)->separate_stderr) | |
| 1218 invalid_change ("stdout and stderr not separate", process); | |
| 1219 if (!NILP (buffer)) | |
| 1220 CHECK_BUFFER (buffer); | |
| 1221 XPROCESS (process)->stderr_buffer = buffer; | |
| 1222 return buffer; | |
| 1223 } | |
| 1224 | |
| 1225 DEFUN ("process-stderr-buffer", Fprocess_stderr_buffer, 1, 1, 0, /* | |
| 1226 Return the stderr buffer PROCESS is associated with. | |
| 2297 | 1227 Output from the stderr of PROCESS is inserted in this buffer unless PROCESS |
| 1228 has a stderr filter. Set the buffer with `set-process-stderr-buffer'. | |
| 853 | 1229 */ |
| 1230 (process)) | |
| 1231 { | |
| 1232 CHECK_PROCESS (process); | |
| 1233 if (!XPROCESS (process)->separate_stderr) | |
| 1234 invalid_change ("stdout and stderr not separate", process); | |
| 1235 return XPROCESS (process)->stderr_buffer; | |
| 1236 } | |
| 1237 | |
| 428 | 1238 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* |
| 1239 Return the marker for the end of the last output from PROCESS. | |
| 1240 */ | |
| 444 | 1241 (process)) |
| 428 | 1242 { |
| 444 | 1243 CHECK_PROCESS (process); |
| 1244 return XPROCESS (process)->mark; | |
| 428 | 1245 } |
| 1246 | |
| 853 | 1247 DEFUN ("process-stderr-mark", Fprocess_stderr_mark, 1, 1, 0, /* |
| 1248 Return the marker for the end of the last stderr output from PROCESS. | |
| 1249 */ | |
| 1250 (process)) | |
| 1251 { | |
| 1252 CHECK_PROCESS (process); | |
| 1253 if (!XPROCESS (process)->separate_stderr) | |
| 1254 invalid_operation ("stdout and stderr not separate", process); | |
| 1255 return XPROCESS (process)->stderr_mark; | |
| 1256 } | |
| 1257 | |
| 428 | 1258 void |
| 853 | 1259 set_process_filter (Lisp_Object process, Lisp_Object filter, |
| 1260 int filter_does_read, int set_stderr) | |
| 428 | 1261 { |
| 444 | 1262 CHECK_PROCESS (process); |
| 853 | 1263 if (set_stderr && !XPROCESS (process)->separate_stderr) |
| 1264 invalid_change ("stdout and stderr not separate", process); | |
| 863 | 1265 if (PROCESS_READABLE_P (XPROCESS (process))) |
| 853 | 1266 { |
| 1267 if (EQ (filter, Qt)) | |
| 1268 event_stream_unselect_process (XPROCESS (process), !set_stderr, | |
| 1269 set_stderr); | |
| 1270 else | |
| 1271 event_stream_select_process (XPROCESS (process), !set_stderr, | |
| 1272 set_stderr); | |
| 1273 } | |
| 428 | 1274 |
| 853 | 1275 if (set_stderr) |
| 1276 XPROCESS (process)->stderr_filter = filter; | |
| 1277 else | |
| 1278 XPROCESS (process)->filter = filter; | |
| 444 | 1279 XPROCESS (process)->filter_does_read = filter_does_read; |
| 428 | 1280 } |
| 1281 | |
| 1282 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* | |
| 1283 Give PROCESS the filter function FILTER; nil means no filter. | |
| 853 | 1284 t means stop accepting output from the process. (If process was created |
| 854 | 1285 with |
| 853 | 1286 When a process has a filter, each time it does output |
| 1287 the entire string of output is passed to the filter. | |
| 1288 The filter gets two arguments: the process and the string of output. | |
| 1289 If the process has a filter, its buffer is not used for output. | |
| 1290 */ | |
| 1291 (process, filter)) | |
| 1292 { | |
| 1293 set_process_filter (process, filter, 0, 0); | |
| 1294 return filter; | |
| 1295 } | |
| 1296 | |
| 1297 DEFUN ("set-process-stderr-filter", Fset_process_stderr_filter, 2, 2, 0, /* | |
| 1298 Give PROCESS the stderr filter function FILTER; nil means no filter. | |
| 428 | 1299 t means stop accepting output from the process. |
| 1300 When a process has a filter, each time it does output | |
| 1301 the entire string of output is passed to the filter. | |
| 1302 The filter gets two arguments: the process and the string of output. | |
| 1303 If the process has a filter, its buffer is not used for output. | |
| 1304 */ | |
| 444 | 1305 (process, filter)) |
| 428 | 1306 { |
| 853 | 1307 set_process_filter (process, filter, 0, 1); |
| 428 | 1308 return filter; |
| 1309 } | |
| 1310 | |
| 1311 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* | |
| 1312 Return the filter function of PROCESS; nil if none. | |
| 1313 See `set-process-filter' for more info on filter functions. | |
| 1314 */ | |
| 444 | 1315 (process)) |
| 428 | 1316 { |
| 444 | 1317 CHECK_PROCESS (process); |
| 1318 return XPROCESS (process)->filter; | |
| 428 | 1319 } |
| 1320 | |
| 853 | 1321 DEFUN ("process-stderr-filter", Fprocess_stderr_filter, 1, 1, 0, /* |
| 1322 Return the filter function of PROCESS; nil if none. | |
| 1323 See `set-process-stderr-filter' for more info on filter functions. | |
| 1324 */ | |
| 1325 (process)) | |
| 1326 { | |
| 1327 CHECK_PROCESS (process); | |
| 1328 if (!XPROCESS (process)->separate_stderr) | |
| 1329 invalid_operation ("stdout and stderr not separate", process); | |
| 1330 return XPROCESS (process)->stderr_filter; | |
| 1331 } | |
| 1332 | |
| 442 | 1333 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /* |
| 1334 Send current contents of the region between START and END as input to PROCESS. | |
| 444 | 1335 PROCESS may be a process or the name of a process, or a buffer or the |
| 1336 name of a buffer, in which case the buffer's process is used. If it | |
| 1337 is nil, the current buffer's process is used. | |
| 442 | 1338 BUFFER specifies the buffer to look in; if nil, the current buffer is used. |
| 853 | 1339 If the region is more than 100 or so characters long, it may be sent in |
| 1340 several chunks. This may happen even for shorter regions. Output | |
| 444 | 1341 from processes can arrive in between chunks. |
| 428 | 1342 */ |
| 442 | 1343 (process, start, end, buffer)) |
| 428 | 1344 { |
| 1345 /* This function can GC */ | |
| 665 | 1346 Charbpos bstart, bend; |
| 442 | 1347 struct buffer *buf = decode_buffer (buffer, 0); |
| 428 | 1348 |
| 793 | 1349 buffer = wrap_buffer (buf); |
| 444 | 1350 process = get_process (process); |
| 1351 get_buffer_range_char (buf, start, end, &bstart, &bend, 0); | |
| 442 | 1352 |
| 444 | 1353 send_process (process, buffer, 0, bstart, bend - bstart); |
| 428 | 1354 return Qnil; |
| 1355 } | |
| 1356 | |
| 1357 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* | |
| 1358 Send PROCESS the contents of STRING as input. | |
| 444 | 1359 PROCESS may be a process or the name of a process, or a buffer or the |
| 1360 name of a buffer, in which case the buffer's process is used. If it | |
| 1361 is nil, the current buffer's process is used. | |
| 1362 Optional arguments START and END specify part of STRING; see `substring'. | |
| 1363 If STRING is more than 100 or so characters long, it may be sent in | |
| 1364 several chunks. This may happen even for shorter strings. Output | |
| 1365 from processes can arrive in between chunks. | |
| 428 | 1366 */ |
| 444 | 1367 (process, string, start, end)) |
| 428 | 1368 { |
| 1369 /* This function can GC */ | |
| 444 | 1370 Bytecount bstart, bend; |
| 428 | 1371 |
| 444 | 1372 process = get_process (process); |
| 428 | 1373 CHECK_STRING (string); |
| 444 | 1374 get_string_range_byte (string, start, end, &bstart, &bend, |
| 428 | 1375 GB_HISTORICAL_STRING_BEHAVIOR); |
| 1376 | |
| 444 | 1377 send_process (process, string, 0, bstart, bend - bstart); |
| 428 | 1378 return Qnil; |
| 1379 } | |
| 1380 | |
| 1381 | |
| 1382 DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* | |
| 1383 Return PROCESS's input coding system. | |
| 1384 */ | |
| 1385 (process)) | |
| 1386 { | |
| 1387 process = get_process (process); | |
| 863 | 1388 CHECK_READABLE_PROCESS (process); |
| 771 | 1389 return (coding_stream_detected_coding_system |
| 1390 (XLSTREAM (XPROCESS (process)->coding_instream))); | |
| 428 | 1391 } |
| 1392 | |
| 1393 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* | |
| 1394 Return PROCESS's output coding system. | |
| 1395 */ | |
| 1396 (process)) | |
| 1397 { | |
| 1398 process = get_process (process); | |
| 440 | 1399 CHECK_LIVE_PROCESS (process); |
| 771 | 1400 return (coding_stream_coding_system |
| 1401 (XLSTREAM (XPROCESS (process)->coding_outstream))); | |
| 428 | 1402 } |
| 1403 | |
| 1404 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* | |
| 1405 Return a pair of coding-system for decoding and encoding of PROCESS. | |
| 1406 */ | |
| 1407 (process)) | |
| 1408 { | |
| 1409 process = get_process (process); | |
| 863 | 1410 CHECK_READABLE_PROCESS (process); |
| 771 | 1411 return Fcons (coding_stream_detected_coding_system |
| 428 | 1412 (XLSTREAM (XPROCESS (process)->coding_instream)), |
| 771 | 1413 coding_stream_coding_system |
| 428 | 1414 (XLSTREAM (XPROCESS (process)->coding_outstream))); |
| 1415 } | |
| 1416 | |
| 1417 DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system, | |
| 1418 2, 2, 0, /* | |
| 1419 Set PROCESS's input coding system to CODESYS. | |
| 771 | 1420 This is used for reading data from PROCESS. |
| 428 | 1421 */ |
| 1422 (process, codesys)) | |
| 1423 { | |
| 771 | 1424 codesys = get_coding_system_for_text_file (codesys, 1); |
| 428 | 1425 process = get_process (process); |
| 863 | 1426 CHECK_READABLE_PROCESS (process); |
| 440 | 1427 |
| 771 | 1428 set_coding_stream_coding_system |
| 428 | 1429 (XLSTREAM (XPROCESS (process)->coding_instream), codesys); |
| 1430 return Qnil; | |
| 1431 } | |
| 1432 | |
| 1433 DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system, | |
| 1434 2, 2, 0, /* | |
| 1435 Set PROCESS's output coding system to CODESYS. | |
| 771 | 1436 This is used for writing data to PROCESS. |
| 428 | 1437 */ |
| 1438 (process, codesys)) | |
| 1439 { | |
| 771 | 1440 codesys = get_coding_system_for_text_file (codesys, 0); |
| 428 | 1441 process = get_process (process); |
| 440 | 1442 CHECK_LIVE_PROCESS (process); |
| 1443 | |
| 771 | 1444 set_coding_stream_coding_system |
| 428 | 1445 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); |
| 1446 return Qnil; | |
| 1447 } | |
| 1448 | |
| 1449 DEFUN ("set-process-coding-system", Fset_process_coding_system, | |
| 1450 1, 3, 0, /* | |
| 1451 Set coding-systems of PROCESS to DECODING and ENCODING. | |
| 440 | 1452 DECODING will be used to decode subprocess output and ENCODING to |
| 1453 encode subprocess input. | |
| 428 | 1454 */ |
| 1455 (process, decoding, encoding)) | |
| 1456 { | |
| 1457 if (!NILP (decoding)) | |
| 1458 Fset_process_input_coding_system (process, decoding); | |
| 1459 | |
| 1460 if (!NILP (encoding)) | |
| 1461 Fset_process_output_coding_system (process, encoding); | |
| 1462 | |
| 1463 return Qnil; | |
| 1464 } | |
| 1465 | |
| 1466 | |
| 1467 /************************************************************************/ | |
| 1468 /* process status */ | |
| 1469 /************************************************************************/ | |
| 1470 | |
| 1471 static Lisp_Object | |
| 1472 exec_sentinel_unwind (Lisp_Object datum) | |
| 1473 { | |
| 853 | 1474 XPROCESS (XCAR (datum))->sentinel = XCDR (datum); |
| 1475 free_cons (datum); | |
| 428 | 1476 return Qnil; |
| 1477 } | |
| 1478 | |
| 1479 static void | |
| 444 | 1480 exec_sentinel (Lisp_Object process, Lisp_Object reason) |
| 428 | 1481 { |
| 1482 /* This function can GC */ | |
| 1483 int speccount = specpdl_depth (); | |
| 444 | 1484 Lisp_Process *p = XPROCESS (process); |
| 428 | 1485 Lisp_Object sentinel = p->sentinel; |
| 1486 | |
| 1487 if (NILP (sentinel)) | |
| 1488 return; | |
| 1489 | |
| 1490 /* Some weird FSFmacs crap here with | |
| 1491 Vdeactivate_mark and current_buffer->keymap */ | |
| 1492 | |
| 853 | 1493 /* Some FSF junk with running_asynch_code, to preserve the match |
| 1494 data. Not necessary because we don't call process filters | |
| 1495 asynchronously (i.e. from within QUIT). */ | |
| 1496 | |
| 428 | 1497 /* Zilch the sentinel while it's running, to avoid recursive invocations; |
| 853 | 1498 assure that it gets restored no matter how the sentinel exits. |
| 1499 | |
| 1500 (#### Why is this necessary? Probably another relic of asynchronous | |
| 1501 calling of process filters/sentinels.) */ | |
| 428 | 1502 p->sentinel = Qnil; |
| 853 | 1503 record_unwind_protect (exec_sentinel_unwind, |
| 1504 noseeum_cons (process, sentinel)); | |
| 1505 /* Don't catch errors here; we're not in any critical code. */ | |
| 1506 call2 (sentinel, process, reason); | |
| 771 | 1507 unbind_to (speccount); |
| 428 | 1508 } |
| 1509 | |
| 1510 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* | |
| 1511 Give PROCESS the sentinel SENTINEL; nil for none. | |
| 1512 The sentinel is called as a function when the process changes state. | |
| 1513 It gets two arguments: the process, and a string describing the change. | |
| 1514 */ | |
| 444 | 1515 (process, sentinel)) |
| 428 | 1516 { |
| 444 | 1517 CHECK_PROCESS (process); |
| 1518 XPROCESS (process)->sentinel = sentinel; | |
| 428 | 1519 return sentinel; |
| 1520 } | |
| 1521 | |
| 1522 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* | |
| 1523 Return the sentinel of PROCESS; nil if none. | |
| 1524 See `set-process-sentinel' for more info on sentinels. | |
| 1525 */ | |
| 444 | 1526 (process)) |
| 428 | 1527 { |
| 444 | 1528 CHECK_PROCESS (process); |
| 1529 return XPROCESS (process)->sentinel; | |
| 428 | 1530 } |
| 1531 | |
| 1532 | |
| 442 | 1533 const char * |
| 428 | 1534 signal_name (int signum) |
| 1535 { | |
| 1536 if (signum >= 0 && signum < NSIG) | |
| 442 | 1537 return (const char *) sys_siglist[signum]; |
| 428 | 1538 |
| 442 | 1539 return (const char *) GETTEXT ("unknown signal"); |
| 428 | 1540 } |
| 1541 | |
| 1542 void | |
| 1543 update_process_status (Lisp_Object p, | |
| 1544 Lisp_Object status_symbol, | |
| 1545 int exit_code, | |
| 1546 int core_dumped) | |
| 1547 { | |
| 1548 XPROCESS (p)->tick++; | |
| 1549 process_tick++; | |
| 1550 XPROCESS (p)->status_symbol = status_symbol; | |
| 1551 XPROCESS (p)->exit_code = exit_code; | |
| 1552 XPROCESS (p)->core_dumped = core_dumped; | |
| 1553 } | |
| 1554 | |
| 1555 /* Return a string describing a process status list. */ | |
| 1556 | |
| 1557 static Lisp_Object | |
| 440 | 1558 status_message (Lisp_Process *p) |
| 428 | 1559 { |
| 1560 Lisp_Object symbol = p->status_symbol; | |
| 1561 int code = p->exit_code; | |
| 1562 int coredump = p->core_dumped; | |
| 1563 Lisp_Object string, string2; | |
| 1564 | |
| 1565 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) | |
| 1566 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1567 string = build_cistring (signal_name (code)); |
| 428 | 1568 if (coredump) |
| 771 | 1569 string2 = build_msg_string (" (core dumped)\n"); |
| 428 | 1570 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1571 string2 = build_ascstring ("\n"); |
| 793 | 1572 set_string_char (string, 0, |
| 867 | 1573 DOWNCASE (0, string_ichar (string, 0))); |
| 428 | 1574 return concat2 (string, string2); |
| 1575 } | |
| 1576 else if (EQ (symbol, Qexit)) | |
| 1577 { | |
| 1578 if (code == 0) | |
| 771 | 1579 return build_msg_string ("finished\n"); |
| 428 | 1580 string = Fnumber_to_string (make_int (code)); |
| 1581 if (coredump) | |
| 771 | 1582 string2 = build_msg_string (" (core dumped)\n"); |
| 428 | 1583 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1584 string2 = build_ascstring ("\n"); |
| 771 | 1585 return concat2 (build_msg_string ("exited abnormally with code "), |
| 428 | 1586 concat2 (string, string2)); |
| 1587 } | |
| 1588 else | |
| 1589 return Fcopy_sequence (Fsymbol_name (symbol)); | |
| 1590 } | |
| 1591 | |
| 1592 /* Tell status_notify() to check for terminated processes. We do this | |
| 1593 because on some systems we sometimes miss SIGCHLD calls. (Not sure | |
| 853 | 1594 why.) This is also used under Mswin. */ |
| 428 | 1595 |
| 1596 void | |
| 1597 kick_status_notify (void) | |
| 1598 { | |
| 1599 process_tick++; | |
| 1600 } | |
| 1601 | |
| 1602 | |
| 1603 /* Report all recent events of a change in process status | |
| 1604 (either run the sentinel or output a message). | |
| 1605 This is done while Emacs is waiting for keyboard input. */ | |
| 1606 | |
| 1607 void | |
| 1608 status_notify (void) | |
| 1609 { | |
| 1610 /* This function can GC */ | |
| 1611 Lisp_Object tail = Qnil; | |
| 1612 Lisp_Object symbol = Qnil; | |
| 1613 Lisp_Object msg = Qnil; | |
| 1614 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 1615 /* process_tick is volatile, so we have to remember it now. | |
| 444 | 1616 Otherwise, we get a race condition if SIGCHLD happens during |
| 428 | 1617 this function. |
| 1618 | |
| 1619 (Actually, this is not the case anymore. The code to | |
| 1620 update the process structures has been moved out of the | |
| 1621 SIGCHLD handler. But for the moment I'm leaving this | |
| 1622 stuff in -- it can't hurt.) */ | |
| 1623 int temp_process_tick; | |
| 1624 | |
| 1625 MAYBE_PROCMETH (reap_exited_processes, ()); | |
| 1626 | |
| 1627 temp_process_tick = process_tick; | |
| 1628 | |
| 1629 if (update_tick == temp_process_tick) | |
| 1630 return; | |
| 1631 | |
| 1632 /* We need to gcpro tail; if read_process_output calls a filter | |
| 1633 which deletes a process and removes the cons to which tail points | |
| 1634 from Vprocess_alist, and then causes a GC, tail is an unprotected | |
| 1635 reference. */ | |
| 1636 GCPRO3 (tail, symbol, msg); | |
| 1637 | |
| 1638 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
| 1639 { | |
| 444 | 1640 Lisp_Object process = XCAR (tail); |
| 1641 Lisp_Process *p = XPROCESS (process); | |
| 428 | 1642 /* p->tick is also volatile. Same thing as above applies. */ |
| 1643 int this_process_tick; | |
| 1644 | |
| 1645 /* #### extra check for terminated processes, in case a SIGCHLD | |
| 1646 got missed (this seems to happen sometimes, I'm not sure why). | |
| 1647 */ | |
| 1648 if (INTP (p->pid)) | |
| 1649 MAYBE_PROCMETH (update_status_if_terminated, (p)); | |
| 1650 | |
| 1651 this_process_tick = p->tick; | |
| 1652 if (this_process_tick != p->update_tick) | |
| 1653 { | |
| 1654 p->update_tick = this_process_tick; | |
| 1655 | |
| 1656 /* If process is still active, read any output that remains. */ | |
| 1657 while (!EQ (p->filter, Qt) | |
| 853 | 1658 && read_process_output (process, 0) > 0) |
| 1659 ; | |
| 1660 while (p->separate_stderr && !EQ (p->stderr_filter, Qt) | |
| 1661 && read_process_output (process, 1) > 0) | |
| 428 | 1662 ; |
| 1663 | |
| 1664 /* Get the text to use for the message. */ | |
| 1665 msg = status_message (p); | |
| 1666 | |
| 1667 /* If process is terminated, deactivate it or delete it. */ | |
| 1668 symbol = p->status_symbol; | |
| 1669 | |
| 1670 if (EQ (symbol, Qsignal) | |
| 1671 || EQ (symbol, Qexit)) | |
| 1672 { | |
| 1673 if (delete_exited_processes) | |
| 444 | 1674 remove_process (process); |
| 428 | 1675 else |
| 444 | 1676 deactivate_process (process); |
| 428 | 1677 } |
| 1678 | |
| 1679 /* Now output the message suitably. */ | |
| 1680 if (!NILP (p->sentinel)) | |
| 444 | 1681 exec_sentinel (process, msg); |
| 428 | 1682 /* Don't bother with a message in the buffer |
| 1683 when a process becomes runnable. */ | |
| 844 | 1684 else if (!EQ (symbol, Qrun) && !NILP (p->buffer) && |
| 1685 /* Avoid error if buffer is deleted | |
| 1686 (probably that's why the process is dead, too) */ | |
| 1687 BUFFER_LIVE_P (XBUFFER (p->buffer))) | |
| 428 | 1688 { |
| 844 | 1689 struct gcpro ngcpro1; |
| 853 | 1690 int spec = process_setup_for_insertion (process, 0); |
| 428 | 1691 |
| 844 | 1692 NGCPRO1 (process); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1693 buffer_insert_ascstring (current_buffer, "\nProcess "); |
| 428 | 1694 Finsert (1, &p->name); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1695 buffer_insert_ascstring (current_buffer, " "); |
| 428 | 1696 Finsert (1, &msg); |
| 1697 Fset_marker (p->mark, make_int (BUF_PT (current_buffer)), | |
| 1698 p->buffer); | |
| 1699 | |
| 844 | 1700 unbind_to (spec); |
| 428 | 1701 NUNGCPRO; |
| 1702 } | |
| 1703 } | |
| 1704 } /* end for */ | |
| 1705 | |
| 1706 /* in case buffers use %s in modeline-format */ | |
| 1707 MARK_MODELINE_CHANGED; | |
| 1708 redisplay (); | |
| 1709 | |
| 1710 update_tick = temp_process_tick; | |
| 1711 | |
| 1712 UNGCPRO; | |
| 1713 } | |
| 1714 | |
| 1715 DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* | |
| 1716 Return the status of PROCESS. | |
| 1717 This is a symbol, one of these: | |
| 1718 | |
| 1719 run -- for a process that is running. | |
| 1720 stop -- for a process stopped but continuable. | |
| 1721 exit -- for a process that has exited. | |
| 1722 signal -- for a process that has got a fatal signal. | |
| 1723 open -- for a network stream connection that is open. | |
| 1724 closed -- for a network stream connection that is closed. | |
| 1725 nil -- if arg is a process name and no such process exists. | |
| 1726 | |
| 1727 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 1728 nil, indicating the current buffer's process. | |
| 1729 */ | |
| 444 | 1730 (process)) |
| 428 | 1731 { |
| 1732 Lisp_Object status_symbol; | |
| 1733 | |
| 444 | 1734 if (STRINGP (process)) |
| 1735 process = Fget_process (process); | |
| 428 | 1736 else |
| 444 | 1737 process = get_process (process); |
| 428 | 1738 |
| 444 | 1739 if (NILP (process)) |
| 428 | 1740 return Qnil; |
| 1741 | |
| 444 | 1742 status_symbol = XPROCESS (process)->status_symbol; |
| 1743 if (network_connection_p (process)) | |
| 428 | 1744 { |
| 1745 if (EQ (status_symbol, Qrun)) | |
| 1746 status_symbol = Qopen; | |
| 1747 else if (EQ (status_symbol, Qexit)) | |
| 1748 status_symbol = Qclosed; | |
| 1749 } | |
| 1750 return status_symbol; | |
| 1751 } | |
| 1752 | |
| 1753 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* | |
| 1754 Return the exit status of PROCESS or the signal number that killed it. | |
| 1755 If PROCESS has not yet exited or died, return 0. | |
| 1756 */ | |
| 444 | 1757 (process)) |
| 428 | 1758 { |
| 444 | 1759 CHECK_PROCESS (process); |
| 1760 return make_int (XPROCESS (process)->exit_code); | |
| 428 | 1761 } |
| 1762 | |
| 1763 | |
| 1764 | |
| 442 | 1765 static int |
| 1766 decode_signal (Lisp_Object signal_) | |
| 428 | 1767 { |
| 442 | 1768 if (INTP (signal_)) |
| 1769 return XINT (signal_); | |
| 428 | 1770 else |
| 1771 { | |
| 867 | 1772 Ibyte *name; |
| 428 | 1773 |
| 442 | 1774 CHECK_SYMBOL (signal_); |
| 793 | 1775 name = XSTRING_DATA (XSYMBOL (signal_)->name); |
| 428 | 1776 |
| 793 | 1777 #define handle_signal(sym) do { \ |
| 2367 | 1778 if (!qxestrcmp_ascii ( name, #sym)) \ |
| 793 | 1779 return sym; \ |
| 442 | 1780 } while (0) |
| 428 | 1781 |
| 1782 handle_signal (SIGINT); /* ANSI */ | |
| 1783 handle_signal (SIGILL); /* ANSI */ | |
| 1784 handle_signal (SIGABRT); /* ANSI */ | |
| 1785 handle_signal (SIGFPE); /* ANSI */ | |
| 1786 handle_signal (SIGSEGV); /* ANSI */ | |
| 1787 handle_signal (SIGTERM); /* ANSI */ | |
| 1788 | |
| 1789 #ifdef SIGHUP | |
| 1790 handle_signal (SIGHUP); /* POSIX */ | |
| 1791 #endif | |
| 1792 #ifdef SIGQUIT | |
| 1793 handle_signal (SIGQUIT); /* POSIX */ | |
| 1794 #endif | |
| 1795 #ifdef SIGTRAP | |
| 1796 handle_signal (SIGTRAP); /* POSIX */ | |
| 1797 #endif | |
| 1798 #ifdef SIGKILL | |
| 1799 handle_signal (SIGKILL); /* POSIX */ | |
| 1800 #endif | |
| 1801 #ifdef SIGUSR1 | |
| 1802 handle_signal (SIGUSR1); /* POSIX */ | |
| 1803 #endif | |
| 1804 #ifdef SIGUSR2 | |
| 1805 handle_signal (SIGUSR2); /* POSIX */ | |
| 1806 #endif | |
| 1807 #ifdef SIGPIPE | |
| 1808 handle_signal (SIGPIPE); /* POSIX */ | |
| 1809 #endif | |
| 1810 #ifdef SIGALRM | |
| 1811 handle_signal (SIGALRM); /* POSIX */ | |
| 1812 #endif | |
| 1813 #ifdef SIGCHLD | |
| 1814 handle_signal (SIGCHLD); /* POSIX */ | |
| 1815 #endif | |
| 1816 #ifdef SIGCONT | |
| 1817 handle_signal (SIGCONT); /* POSIX */ | |
| 1818 #endif | |
| 1819 #ifdef SIGSTOP | |
| 1820 handle_signal (SIGSTOP); /* POSIX */ | |
| 1821 #endif | |
| 1822 #ifdef SIGTSTP | |
| 1823 handle_signal (SIGTSTP); /* POSIX */ | |
| 1824 #endif | |
| 1825 #ifdef SIGTTIN | |
| 1826 handle_signal (SIGTTIN); /* POSIX */ | |
| 1827 #endif | |
| 1828 #ifdef SIGTTOU | |
| 1829 handle_signal (SIGTTOU); /* POSIX */ | |
| 1830 #endif | |
| 1831 | |
| 1832 #ifdef SIGBUS | |
| 1833 handle_signal (SIGBUS); /* XPG5 */ | |
| 1834 #endif | |
| 1835 #ifdef SIGPOLL | |
| 1836 handle_signal (SIGPOLL); /* XPG5 */ | |
| 1837 #endif | |
| 1838 #ifdef SIGPROF | |
| 1839 handle_signal (SIGPROF); /* XPG5 */ | |
| 1840 #endif | |
| 1841 #ifdef SIGSYS | |
| 1842 handle_signal (SIGSYS); /* XPG5 */ | |
| 1843 #endif | |
| 1844 #ifdef SIGURG | |
| 1845 handle_signal (SIGURG); /* XPG5 */ | |
| 1846 #endif | |
| 1847 #ifdef SIGXCPU | |
| 1848 handle_signal (SIGXCPU); /* XPG5 */ | |
| 1849 #endif | |
| 1850 #ifdef SIGXFSZ | |
| 1851 handle_signal (SIGXFSZ); /* XPG5 */ | |
| 1852 #endif | |
| 1853 #ifdef SIGVTALRM | |
| 1854 handle_signal (SIGVTALRM); /* XPG5 */ | |
| 1855 #endif | |
| 1856 | |
| 1857 #ifdef SIGIO | |
| 1858 handle_signal (SIGIO); /* BSD 4.2 */ | |
| 1859 #endif | |
| 1860 #ifdef SIGWINCH | |
| 1861 handle_signal (SIGWINCH); /* BSD 4.3 */ | |
| 1862 #endif | |
| 1863 | |
| 1864 #ifdef SIGEMT | |
| 1865 handle_signal (SIGEMT); | |
| 1866 #endif | |
| 1867 #ifdef SIGINFO | |
| 1868 handle_signal (SIGINFO); | |
| 1869 #endif | |
| 1870 #ifdef SIGHWE | |
| 1871 handle_signal (SIGHWE); | |
| 1872 #endif | |
| 1873 #ifdef SIGPRE | |
| 1874 handle_signal (SIGPRE); | |
| 1875 #endif | |
| 1876 #ifdef SIGUME | |
| 1877 handle_signal (SIGUME); | |
| 1878 #endif | |
| 1879 #ifdef SIGDLK | |
| 1880 handle_signal (SIGDLK); | |
| 1881 #endif | |
| 1882 #ifdef SIGCPULIM | |
| 1883 handle_signal (SIGCPULIM); | |
| 1884 #endif | |
| 1885 #ifdef SIGIOT | |
| 1886 handle_signal (SIGIOT); | |
| 1887 #endif | |
| 1888 #ifdef SIGLOST | |
| 1889 handle_signal (SIGLOST); | |
| 1890 #endif | |
| 1891 #ifdef SIGSTKFLT | |
| 1892 handle_signal (SIGSTKFLT); | |
| 1893 #endif | |
| 1894 #ifdef SIGUNUSED | |
| 1895 handle_signal (SIGUNUSED); | |
| 1896 #endif | |
| 1897 #ifdef SIGDANGER | |
| 1898 handle_signal (SIGDANGER); /* AIX */ | |
| 1899 #endif | |
| 1900 #ifdef SIGMSG | |
| 1901 handle_signal (SIGMSG); | |
| 1902 #endif | |
| 1903 #ifdef SIGSOUND | |
| 1904 handle_signal (SIGSOUND); | |
| 1905 #endif | |
| 1906 #ifdef SIGRETRACT | |
| 1907 handle_signal (SIGRETRACT); | |
| 1908 #endif | |
| 1909 #ifdef SIGGRANT | |
| 1910 handle_signal (SIGGRANT); | |
| 1911 #endif | |
| 1912 #ifdef SIGPWR | |
| 1913 handle_signal (SIGPWR); | |
| 1914 #endif | |
| 1915 | |
| 1916 #undef handle_signal | |
| 1917 | |
| 563 | 1918 invalid_constant ("Undefined signal name", signal_); |
| 1204 | 1919 RETURN_NOT_REACHED (0); |
| 442 | 1920 } |
| 1921 } | |
| 1922 | |
| 1923 /* Send signal number SIGNO to PROCESS. | |
| 1924 CURRENT-GROUP non-nil means send signal to the current | |
| 1925 foreground process group of the process's controlling terminal rather | |
| 1926 than to the process's own process group. | |
| 1927 This is used for various commands in shell mode. | |
| 1928 If NOMSG is zero, insert signal-announcements into process's buffers | |
| 1929 right away. | |
| 1930 | |
| 1931 If we can, we try to signal PROCESS by sending control characters | |
| 1932 down the pty. This allows us to signal inferiors who have changed | |
| 1933 their uid, for which kill() would return an EPERM error, or to | |
| 1934 processes running on another computer through a remote login. */ | |
| 1935 | |
| 1936 static void | |
| 1937 process_send_signal (Lisp_Object process, int signo, | |
| 1938 int current_group, int nomsg) | |
| 1939 { | |
| 1940 /* This function can GC */ | |
| 444 | 1941 process = get_process (process); |
| 442 | 1942 |
| 444 | 1943 if (network_connection_p (process)) |
| 563 | 1944 invalid_operation ("Network connection is not a subprocess", process); |
| 444 | 1945 CHECK_LIVE_PROCESS (process); |
| 442 | 1946 |
| 444 | 1947 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg)); |
| 442 | 1948 } |
| 1949 | |
| 1950 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /* | |
| 1951 Send signal SIGNAL to process PROCESS. | |
| 1952 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
| 1953 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 1954 nil, indicating the current buffer's process. | |
| 1955 Third arg CURRENT-GROUP non-nil means send signal to the current | |
| 1956 foreground process group of the process's controlling terminal rather | |
| 1957 than to the process's own process group. | |
| 1958 If the process is a shell that supports job control, this means | |
| 1959 send the signal to the current subjob rather than the shell. | |
| 1960 */ | |
| 1961 (signal_, process, current_group)) | |
| 1962 { | |
| 1963 /* This function can GC */ | |
| 1964 process_send_signal (process, decode_signal (signal_), | |
| 1965 !NILP (current_group), 0); | |
| 1966 return process; | |
| 1967 } | |
| 1968 | |
| 1969 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* | |
| 1970 Interrupt process PROCESS. | |
| 1971 See function `process-send-signal' for more details on usage. | |
| 1972 */ | |
| 1973 (process, current_group)) | |
| 1974 { | |
| 1975 /* This function can GC */ | |
| 1976 process_send_signal (process, SIGINT, !NILP (current_group), 0); | |
| 1977 return process; | |
| 1978 } | |
| 1979 | |
| 1980 DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* | |
| 1981 Kill process PROCESS. | |
| 1982 See function `process-send-signal' for more details on usage. | |
| 1983 */ | |
| 1984 (process, current_group)) | |
| 1985 { | |
| 1986 /* This function can GC */ | |
| 1987 #ifdef SIGKILL | |
| 1988 process_send_signal (process, SIGKILL, !NILP (current_group), 0); | |
| 1989 #else | |
| 563 | 1990 signal_error (Qunimplemented, |
| 1991 "kill-process: Not supported on this system", | |
| 1992 Qunbound); | |
| 442 | 1993 #endif |
| 1994 return process; | |
| 1995 } | |
| 1996 | |
| 1997 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* | |
| 1998 Send QUIT signal to process PROCESS. | |
| 1999 See function `process-send-signal' for more details on usage. | |
| 2000 */ | |
| 2001 (process, current_group)) | |
| 2002 { | |
| 2003 /* This function can GC */ | |
| 2004 #ifdef SIGQUIT | |
| 2005 process_send_signal (process, SIGQUIT, !NILP (current_group), 0); | |
| 2006 #else | |
| 563 | 2007 signal_error (Qunimplemented, |
| 2008 "quit-process: Not supported on this system", | |
| 2009 Qunbound); | |
| 442 | 2010 #endif |
| 2011 return process; | |
| 2012 } | |
| 2013 | |
| 2014 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* | |
| 2015 Stop process PROCESS. | |
| 2016 See function `process-send-signal' for more details on usage. | |
| 2017 */ | |
| 2018 (process, current_group)) | |
| 2019 { | |
| 2020 /* This function can GC */ | |
| 2021 #ifdef SIGTSTP | |
| 2022 process_send_signal (process, SIGTSTP, !NILP (current_group), 0); | |
| 2023 #else | |
| 563 | 2024 signal_error (Qunimplemented, |
| 2025 "stop-process: Not supported on this system", | |
| 2026 Qunbound); | |
| 442 | 2027 #endif |
| 2028 return process; | |
| 2029 } | |
| 2030 | |
| 2031 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* | |
| 2032 Continue process PROCESS. | |
| 2033 See function `process-send-signal' for more details on usage. | |
| 2034 */ | |
| 2035 (process, current_group)) | |
| 2036 { | |
| 2037 /* This function can GC */ | |
| 2038 #ifdef SIGCONT | |
| 2039 process_send_signal (process, SIGCONT, !NILP (current_group), 0); | |
| 2040 #else | |
| 563 | 2041 signal_error (Qunimplemented, |
| 2042 "continue-process: Not supported on this system", | |
| 2043 Qunbound); | |
| 442 | 2044 #endif |
| 2045 return process; | |
| 2046 } | |
| 2047 | |
| 2048 DEFUN ("signal-process", Fsignal_process, 2, 2, | |
| 2049 "nProcess number: \nnSignal code: ", /* | |
| 2050 Send the process with process id PID the signal with code SIGNAL. | |
| 2051 PID must be an integer. The process need not be a child of this Emacs. | |
| 2052 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
| 2053 */ | |
| 2054 (pid, signal_)) | |
| 2055 { | |
| 2056 CHECK_INT (pid); | |
| 2057 | |
| 428 | 2058 return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, |
| 442 | 2059 (XINT (pid), decode_signal (signal_)), |
| 2060 -1)); | |
| 428 | 2061 } |
| 2062 | |
| 2063 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* | |
| 2064 Make PROCESS see end-of-file in its input. | |
| 2065 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 2066 nil, indicating the current buffer's process. | |
| 2067 If PROCESS is a network connection, or is a process communicating | |
| 2068 through a pipe (as opposed to a pty), then you cannot send any more | |
| 2069 text to PROCESS after you call this function. | |
| 2070 */ | |
| 2071 (process)) | |
| 2072 { | |
| 2073 /* This function can GC */ | |
| 444 | 2074 process = get_process (process); |
| 428 | 2075 |
| 2076 /* Make sure the process is really alive. */ | |
| 444 | 2077 if (! EQ (XPROCESS (process)->status_symbol, Qrun)) |
| 563 | 2078 invalid_operation ("Process not running", process); |
| 428 | 2079 |
| 444 | 2080 if (!MAYBE_INT_PROCMETH (process_send_eof, (process))) |
| 428 | 2081 { |
| 444 | 2082 if (!NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
| 428 | 2083 { |
| 853 | 2084 USID humpty, dumpty; |
| 444 | 2085 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process)))); |
| 853 | 2086 event_stream_delete_io_streams (Qnil, |
| 2087 XPROCESS (process)->pipe_outstream, | |
| 2088 Qnil, &humpty, &dumpty); | |
| 444 | 2089 XPROCESS (process)->pipe_outstream = Qnil; |
| 2090 XPROCESS (process)->coding_outstream = Qnil; | |
| 428 | 2091 } |
| 2092 } | |
| 2093 | |
| 2094 return process; | |
| 2095 } | |
| 2096 | |
| 2097 | |
| 2098 /************************************************************************/ | |
| 2099 /* deleting a process */ | |
| 2100 /************************************************************************/ | |
| 2101 | |
| 2102 void | |
| 444 | 2103 deactivate_process (Lisp_Object process) |
| 428 | 2104 { |
| 444 | 2105 Lisp_Process *p = XPROCESS (process); |
| 853 | 2106 USID in_usid, err_usid; |
| 428 | 2107 |
| 2108 /* It's possible that we got as far in the process-creation | |
| 2109 process as creating the descriptors but didn't get so | |
| 2110 far as selecting the process for input. In this | |
| 2111 case, p->pid is nil: p->pid is set at the same time that | |
| 2112 the process is selected for input. */ | |
| 2113 /* #### The comment does not look correct. event_stream_unselect_process | |
| 853 | 2114 is guarded by process->*_selected, so this is not a problem. - kkm*/ |
| 428 | 2115 /* Must call this before setting the streams to nil */ |
| 853 | 2116 event_stream_unselect_process (p, 1, 1); |
| 428 | 2117 |
| 2118 if (!NILP (DATA_OUTSTREAM (p))) | |
| 2119 Lstream_close (XLSTREAM (DATA_OUTSTREAM (p))); | |
| 2120 if (!NILP (DATA_INSTREAM (p))) | |
| 2121 Lstream_close (XLSTREAM (DATA_INSTREAM (p))); | |
| 853 | 2122 if (!NILP (DATA_ERRSTREAM (p))) |
| 2123 Lstream_close (XLSTREAM (DATA_ERRSTREAM (p))); | |
| 428 | 2124 |
| 2125 /* Provide minimal implementation for deactivate_process | |
| 2126 if there's no process-specific one */ | |
| 2127 if (HAS_PROCMETH_P (deactivate_process)) | |
| 853 | 2128 PROCMETH (deactivate_process, (p, &in_usid, &err_usid)); |
| 428 | 2129 else |
| 853 | 2130 event_stream_delete_io_streams (p->pipe_instream, |
| 2131 p->pipe_outstream, | |
| 2132 p->pipe_errstream, | |
| 2133 &in_usid, &err_usid); | |
| 428 | 2134 |
| 853 | 2135 if (in_usid != USID_DONTHASH) |
| 2367 | 2136 remhash ((const void *) in_usid, usid_to_process); |
| 853 | 2137 if (err_usid != USID_DONTHASH) |
| 2367 | 2138 remhash ((const void *) err_usid, usid_to_process); |
| 428 | 2139 |
| 2140 p->pipe_instream = Qnil; | |
| 2141 p->pipe_outstream = Qnil; | |
| 853 | 2142 p->pipe_errstream = Qnil; |
| 428 | 2143 p->coding_instream = Qnil; |
| 2144 p->coding_outstream = Qnil; | |
| 853 | 2145 p->coding_errstream = Qnil; |
| 428 | 2146 } |
| 2147 | |
| 2148 static void | |
| 444 | 2149 remove_process (Lisp_Object process) |
| 428 | 2150 { |
| 444 | 2151 Vprocess_list = delq_no_quit (process, Vprocess_list); |
| 428 | 2152 |
| 444 | 2153 deactivate_process (process); |
| 428 | 2154 } |
| 2155 | |
| 2156 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* | |
| 2157 Delete PROCESS: kill it and forget about it immediately. | |
| 2158 PROCESS may be a process or the name of one, or a buffer name. | |
| 2159 */ | |
| 444 | 2160 (process)) |
| 428 | 2161 { |
| 2162 /* This function can GC */ | |
| 440 | 2163 Lisp_Process *p; |
| 444 | 2164 process = get_process (process); |
| 2165 p = XPROCESS (process); | |
| 2166 if (network_connection_p (process)) | |
| 428 | 2167 { |
| 2168 p->status_symbol = Qexit; | |
| 2169 p->exit_code = 0; | |
| 2170 p->core_dumped = 0; | |
| 2171 p->tick++; | |
| 2172 process_tick++; | |
| 2173 } | |
| 440 | 2174 else if (PROCESS_LIVE_P (p)) |
| 428 | 2175 { |
| 444 | 2176 Fkill_process (process, Qnil); |
| 428 | 2177 /* Do this now, since remove_process will make sigchld_handler do nothing. */ |
| 2178 p->status_symbol = Qsignal; | |
| 2179 p->exit_code = SIGKILL; | |
| 2180 p->core_dumped = 0; | |
| 2181 p->tick++; | |
| 2182 process_tick++; | |
| 2183 status_notify (); | |
| 2184 } | |
| 444 | 2185 remove_process (process); |
| 428 | 2186 return Qnil; |
| 2187 } | |
| 2188 | |
| 2189 /* Kill all processes associated with `buffer'. | |
| 2190 If `buffer' is nil, kill all processes */ | |
| 2191 | |
| 2192 void | |
| 2193 kill_buffer_processes (Lisp_Object buffer) | |
| 2194 { | |
| 444 | 2195 LIST_LOOP_2 (process, Vprocess_list) |
| 2196 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer))) | |
| 2197 { | |
| 2198 if (network_connection_p (process)) | |
| 2199 Fdelete_process (process); | |
| 2200 else if (PROCESS_LIVE_P (XPROCESS (process))) | |
| 2201 process_send_signal (process, SIGHUP, 0, 1); | |
| 2202 } | |
| 428 | 2203 } |
| 2204 | |
| 2205 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* | |
| 2206 Say no query needed if PROCESS is running when Emacs is exited. | |
| 2207 Optional second argument if non-nil says to require a query. | |
| 2208 Value is t if a query was formerly required. | |
| 2209 */ | |
| 444 | 2210 (process, require_query_p)) |
| 428 | 2211 { |
| 2212 int tem; | |
| 2213 | |
| 444 | 2214 CHECK_PROCESS (process); |
| 2215 tem = XPROCESS (process)->kill_without_query; | |
| 2216 XPROCESS (process)->kill_without_query = NILP (require_query_p); | |
| 428 | 2217 |
| 2218 return tem ? Qnil : Qt; | |
| 2219 } | |
| 2220 | |
| 2221 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* | |
| 444 | 2222 Return t if PROCESS will be killed without query when emacs is exited. |
| 428 | 2223 */ |
| 444 | 2224 (process)) |
| 428 | 2225 { |
| 444 | 2226 CHECK_PROCESS (process); |
| 2227 return XPROCESS (process)->kill_without_query ? Qt : Qnil; | |
| 428 | 2228 } |
| 2229 | |
| 2230 | |
| 2231 #if 0 | |
| 2232 | |
| 826 | 2233 DEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* |
| 428 | 2234 Return the connection type of `PROCESS'. This can be nil (pipe), |
| 2235 t or pty (pty) or stream (socket connection). | |
| 2236 */ | |
| 2237 (process)) | |
| 2238 { | |
| 2239 return XPROCESS (process)->type; | |
| 2240 } | |
| 2241 | |
| 2242 #endif /* 0 */ | |
| 2243 | |
| 814 | 2244 |
| 2245 static int | |
| 867 | 2246 getenv_internal (const Ibyte *var, |
| 814 | 2247 Bytecount varlen, |
| 867 | 2248 Ibyte **value, |
| 814 | 2249 Bytecount *valuelen) |
| 2250 { | |
| 2251 Lisp_Object scan; | |
| 2252 | |
| 2253 assert (env_initted); | |
| 2254 | |
| 2255 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
| 2256 { | |
| 2257 Lisp_Object entry = XCAR (scan); | |
| 2258 | |
| 2259 if (STRINGP (entry) | |
| 2260 && XSTRING_LENGTH (entry) > varlen | |
| 826 | 2261 && string_byte (entry, varlen) == '=' |
| 814 | 2262 #ifdef WIN32_NATIVE |
| 2263 /* NT environment variables are case insensitive. */ | |
| 2264 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
| 2265 #else /* not WIN32_NATIVE */ | |
| 2266 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
| 2267 #endif /* not WIN32_NATIVE */ | |
| 2268 ) | |
| 2269 { | |
| 2270 *value = XSTRING_DATA (entry) + (varlen + 1); | |
| 2271 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); | |
| 2272 return 1; | |
| 2273 } | |
| 2274 } | |
| 2275 | |
| 2276 return 0; | |
| 2277 } | |
| 2278 | |
| 2279 static void | |
| 867 | 2280 putenv_internal (const Ibyte *var, |
| 814 | 2281 Bytecount varlen, |
| 867 | 2282 const Ibyte *value, |
| 814 | 2283 Bytecount valuelen) |
| 2284 { | |
| 2285 Lisp_Object scan; | |
| 2286 | |
| 2287 assert (env_initted); | |
| 2288 | |
| 2289 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
| 2290 { | |
| 2291 Lisp_Object entry = XCAR (scan); | |
| 2292 | |
| 2293 if (STRINGP (entry) | |
| 2294 && XSTRING_LENGTH (entry) > varlen | |
| 826 | 2295 && string_byte (entry, varlen) == '=' |
| 814 | 2296 #ifdef WIN32_NATIVE |
| 2297 /* NT environment variables are case insensitive. */ | |
| 2298 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
| 2299 #else /* not WIN32_NATIVE */ | |
| 2300 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
| 2301 #endif /* not WIN32_NATIVE */ | |
| 2302 ) | |
| 2303 { | |
| 2304 XCAR (scan) = concat3 (make_string (var, varlen), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2305 build_ascstring ("="), |
| 814 | 2306 make_string (value, valuelen)); |
| 2307 return; | |
| 2308 } | |
| 2309 } | |
| 2310 | |
| 2311 Vprocess_environment = Fcons (concat3 (make_string (var, varlen), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2312 build_ascstring ("="), |
| 814 | 2313 make_string (value, valuelen)), |
| 2314 Vprocess_environment); | |
| 2315 } | |
| 2316 | |
| 2317 /* NOTE: | |
| 2318 | |
| 2319 FSF has this as a Lisp function, as follows. Generally moving things | |
| 2320 out of C and into Lisp is a good idea, but in this case the Lisp | |
| 2321 function is used so early in the startup sequence that it would be ugly | |
| 2322 to rearrange the early dumped code to accommodate this. | |
| 854 | 2323 |
| 814 | 2324 (defun getenv (variable) |
| 2325 "Get the value of environment variable VARIABLE. | |
| 2326 VARIABLE should be a string. Value is nil if VARIABLE is undefined in | |
| 2327 the environment. Otherwise, value is a string. | |
| 2328 | |
| 2329 This function consults the variable `process-environment' | |
| 2330 for its value." | |
| 2331 (interactive (list (read-envvar-name "Get environment variable: " t))) | |
| 2332 (let ((value (getenv-internal variable))) | |
| 2333 (when (interactive-p) | |
| 2334 (message "%s" (if value value "Not set"))) | |
| 2335 value)) | |
| 2336 */ | |
| 2337 | |
| 2338 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* | |
| 2339 Return the value of environment variable VAR, as a string. | |
| 2340 VAR is a string, the name of the variable. | |
| 2341 When invoked interactively, prints the value in the echo area. | |
| 2342 */ | |
| 2343 (var, interactivep)) | |
| 2344 { | |
| 4932 | 2345 Ibyte *value = NULL; |
| 814 | 2346 Bytecount valuelen; |
| 2347 Lisp_Object v = Qnil; | |
| 2348 struct gcpro gcpro1; | |
| 2349 | |
| 2350 CHECK_STRING (var); | |
| 2351 GCPRO1 (v); | |
| 2352 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var), | |
| 2353 &value, &valuelen)) | |
| 2354 v = make_string (value, valuelen); | |
| 2355 if (!NILP (interactivep)) | |
| 2356 { | |
| 2357 if (NILP (v)) | |
| 2358 message ("%s not defined in environment", XSTRING_DATA (var)); | |
| 2359 else | |
| 2360 /* #### Should use Fprin1_to_string or Fprin1 to handle string | |
| 2361 containing quotes correctly. */ | |
| 2362 message ("\"%s\"", value); | |
| 2363 } | |
| 2364 RETURN_UNGCPRO (v); | |
| 2365 } | |
| 2366 | |
| 2367 /* A version of getenv that consults Vprocess_environment, easily | |
| 2368 callable from C. | |
| 2369 | |
| 2370 (At init time, Vprocess_environment is initialized from the | |
| 2371 environment, stored in the global variable environ. [Note that | |
| 2372 at startup time, `environ' should be the same as the envp parameter | |
| 2373 passed to main(); however, later calls to putenv() may change | |
| 2374 `environ', making the envp parameter inaccurate.] Calls to getenv() | |
| 2375 and putenv() consult and modify `environ'. However, once | |
| 2376 Vprocess_environment is initted, XEmacs C code should *NEVER* call | |
| 2377 getenv() or putenv() directly, because (1) Lisp code that modifies | |
| 2378 the environment only modifies Vprocess_environment, not `environ'; | |
| 2379 and (2) Vprocess_environment is in internal format but `environ' | |
| 2380 is in some external format, and getenv()/putenv() are not Mule- | |
| 2381 encapsulated. | |
| 2382 | |
| 2383 WARNING: This value points into Lisp string data and thus will become | |
| 2384 invalid after a GC. */ | |
| 2385 | |
| 867 | 2386 Ibyte * |
| 2387 egetenv (const CIbyte *var) | |
| 814 | 2388 { |
| 2389 /* This cannot GC -- 7-28-00 ben */ | |
| 867 | 2390 Ibyte *value; |
| 814 | 2391 Bytecount valuelen; |
| 2392 | |
| 867 | 2393 if (getenv_internal ((const Ibyte *) var, strlen (var), &value, &valuelen)) |
| 814 | 2394 return value; |
| 2395 else | |
| 2396 return 0; | |
| 2397 } | |
| 2398 | |
| 2399 void | |
| 867 | 2400 eputenv (const CIbyte *var, const CIbyte *value) |
| 814 | 2401 { |
| 867 | 2402 putenv_internal ((Ibyte *) var, strlen (var), (Ibyte *) value, |
| 814 | 2403 strlen (value)); |
| 2404 } | |
| 2405 | |
| 2406 | |
| 2407 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ | |
| 2408 void | |
| 2409 init_xemacs_process (void) | |
| 2410 { | |
| 2411 /* This function can GC */ | |
| 2412 | |
| 2413 MAYBE_PROCMETH (init_process, ()); | |
| 2414 | |
| 2415 Vprocess_list = Qnil; | |
| 2416 | |
| 2417 if (usid_to_process) | |
| 2418 clrhash (usid_to_process); | |
| 2419 else | |
| 2420 usid_to_process = make_hash_table (32); | |
| 854 | 2421 |
| 814 | 2422 { |
| 2423 /* jwz: always initialize Vprocess_environment, so that egetenv() | |
| 2424 works in temacs. */ | |
| 2367 | 2425 Extbyte **envp; |
| 814 | 2426 Vprocess_environment = Qnil; |
| 2367 | 2427 #ifdef WIN32_NATIVE |
| 2428 _wgetenv (L""); /* force initialization of _wenviron */ | |
| 2429 for (envp = (Extbyte **) _wenviron; envp && *envp; envp++) | |
| 2430 Vprocess_environment = | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2431 Fcons (build_extstring (*envp, Qmswindows_unicode), |
| 2367 | 2432 Vprocess_environment); |
| 2433 #else | |
| 814 | 2434 for (envp = environ; envp && *envp; envp++) |
| 2435 Vprocess_environment = | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2436 Fcons (build_extstring (*envp, Qenvironment_variable_encoding), |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2437 Vprocess_environment); |
| 2367 | 2438 #endif |
| 814 | 2439 /* This gets set back to 0 in disksave_object_finalization() */ |
| 2440 env_initted = 1; | |
| 2441 } | |
| 2442 | |
| 2443 { | |
| 2444 /* Initialize shell-file-name from environment variables or best guess. */ | |
| 2445 #ifdef WIN32_NATIVE | |
| 867 | 2446 const Ibyte *shell = egetenv ("SHELL"); |
| 814 | 2447 if (!shell) shell = egetenv ("COMSPEC"); |
| 2448 /* Should never happen! */ | |
| 2449 if (!shell) shell = | |
| 867 | 2450 (Ibyte *) (GetVersion () & 0x80000000 ? "command" : "cmd"); |
| 814 | 2451 #else /* not WIN32_NATIVE */ |
| 867 | 2452 const Ibyte *shell = egetenv ("SHELL"); |
| 2453 if (!shell) shell = (Ibyte *) "/bin/sh"; | |
| 814 | 2454 #endif |
| 2455 | |
| 2456 #if 0 /* defined (WIN32_NATIVE) */ | |
| 2457 /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created | |
| 2458 SHELL var down to some inferior Cygwin process, which might get | |
| 2459 screwed up. | |
| 854 | 2460 |
| 814 | 2461 There are a few broken apps (eterm/term.el, eterm/tshell.el, |
| 2462 os-utils/terminal.el, texinfo/tex-mode.el) where this will | |
| 2463 cause problems. Those broken apps don't look at | |
| 2464 shell-file-name, instead just at explicit-shell-file-name, | |
| 2465 ESHELL and SHELL. They are apparently attempting to borrow | |
| 2466 what `M-x shell' uses, but that latter also looks at | |
| 2467 shell-file-name. What we want is for all of these apps to look | |
| 2468 at shell-file-name, so that the user can change the value of | |
| 2469 shell-file-name and everything will work out hunky-dorey. | |
| 2470 */ | |
| 854 | 2471 |
| 814 | 2472 if (!egetenv ("SHELL")) |
| 2473 { | |
| 2367 | 2474 Ibyte *faux_var = alloca_ibytes (7 + qxestrlen (shell)); |
| 814 | 2475 qxesprintf (faux_var, "SHELL=%s", shell); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2476 Vprocess_environment = Fcons (build_istring (faux_var), |
| 814 | 2477 Vprocess_environment); |
| 2478 } | |
| 2479 #endif /* 0 */ | |
| 2480 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2481 Vshell_file_name = build_istring (shell); |
| 814 | 2482 } |
| 2483 } | |
| 2484 | |
| 428 | 2485 void |
| 2486 syms_of_process (void) | |
| 2487 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
2488 INIT_LISP_OBJECT (process); |
| 442 | 2489 |
| 563 | 2490 DEFSYMBOL (Qprocessp); |
| 2491 DEFSYMBOL (Qprocess_live_p); | |
| 2492 DEFSYMBOL (Qrun); | |
| 2493 DEFSYMBOL (Qstop); | |
| 2494 DEFSYMBOL (Qopen); | |
| 2495 DEFSYMBOL (Qclosed); | |
| 863 | 2496 #if 0 |
| 2497 /* see comment at Fprocess_readable_p */ | |
| 2498 DEFSYMBOL (&Qprocess_readable_p); | |
| 2499 #endif | |
| 563 | 2500 DEFSYMBOL (Qtcp); |
| 2501 DEFSYMBOL (Qudp); | |
| 428 | 2502 |
| 2503 #ifdef HAVE_MULTICAST | |
| 563 | 2504 DEFSYMBOL (Qmulticast); /* Used for occasional warnings */ |
| 428 | 2505 #endif |
| 2506 | |
| 563 | 2507 DEFERROR_STANDARD (Qprocess_error, Qio_error); |
| 2508 DEFERROR_STANDARD (Qnetwork_error, Qio_error); | |
| 2509 | |
| 428 | 2510 DEFSUBR (Fprocessp); |
| 440 | 2511 DEFSUBR (Fprocess_live_p); |
| 863 | 2512 #if 0 |
| 2513 /* see comment at Fprocess_readable_p */ | |
| 2514 DEFSUBR (Fprocess_readable_p); | |
| 2515 #endif | |
| 428 | 2516 DEFSUBR (Fget_process); |
| 2517 DEFSUBR (Fget_buffer_process); | |
| 2518 DEFSUBR (Fdelete_process); | |
| 2519 DEFSUBR (Fprocess_status); | |
| 2520 DEFSUBR (Fprocess_exit_status); | |
| 2521 DEFSUBR (Fprocess_id); | |
| 2522 DEFSUBR (Fprocess_name); | |
| 2523 DEFSUBR (Fprocess_tty_name); | |
| 2524 DEFSUBR (Fprocess_command); | |
| 859 | 2525 DEFSUBR (Fprocess_has_separate_stderr_p); |
| 428 | 2526 DEFSUBR (Fset_process_buffer); |
| 853 | 2527 DEFSUBR (Fset_process_stderr_buffer); |
| 428 | 2528 DEFSUBR (Fprocess_buffer); |
| 2529 DEFSUBR (Fprocess_mark); | |
| 853 | 2530 DEFSUBR (Fprocess_stderr_buffer); |
| 2531 DEFSUBR (Fprocess_stderr_mark); | |
| 428 | 2532 DEFSUBR (Fset_process_filter); |
| 2533 DEFSUBR (Fprocess_filter); | |
| 853 | 2534 DEFSUBR (Fset_process_stderr_filter); |
| 2535 DEFSUBR (Fprocess_stderr_filter); | |
| 428 | 2536 DEFSUBR (Fset_process_window_size); |
| 2537 DEFSUBR (Fset_process_sentinel); | |
| 2538 DEFSUBR (Fprocess_sentinel); | |
| 2539 DEFSUBR (Fprocess_kill_without_query); | |
| 2540 DEFSUBR (Fprocess_kill_without_query_p); | |
| 2541 DEFSUBR (Fprocess_list); | |
| 2542 DEFSUBR (Fstart_process_internal); | |
| 2543 #ifdef HAVE_SOCKETS | |
| 2544 DEFSUBR (Fopen_network_stream_internal); | |
| 2545 #ifdef HAVE_MULTICAST | |
| 2546 DEFSUBR (Fopen_multicast_group_internal); | |
| 2547 #endif /* HAVE_MULTICAST */ | |
| 2548 #endif /* HAVE_SOCKETS */ | |
| 2549 DEFSUBR (Fprocess_send_region); | |
| 2550 DEFSUBR (Fprocess_send_string); | |
| 442 | 2551 DEFSUBR (Fprocess_send_signal); |
| 428 | 2552 DEFSUBR (Finterrupt_process); |
| 2553 DEFSUBR (Fkill_process); | |
| 2554 DEFSUBR (Fquit_process); | |
| 2555 DEFSUBR (Fstop_process); | |
| 2556 DEFSUBR (Fcontinue_process); | |
| 2557 DEFSUBR (Fprocess_send_eof); | |
| 2558 DEFSUBR (Fsignal_process); | |
| 2559 /* DEFSUBR (Fprocess_connection); */ | |
| 2560 DEFSUBR (Fprocess_input_coding_system); | |
| 2561 DEFSUBR (Fprocess_output_coding_system); | |
| 2562 DEFSUBR (Fset_process_input_coding_system); | |
| 2563 DEFSUBR (Fset_process_output_coding_system); | |
| 2564 DEFSUBR (Fprocess_coding_system); | |
| 2565 DEFSUBR (Fset_process_coding_system); | |
| 814 | 2566 DEFSUBR (Fgetenv); |
| 428 | 2567 } |
| 2568 | |
| 2569 void | |
| 2570 vars_of_process (void) | |
| 2571 { | |
| 2572 Fprovide (intern ("subprocesses")); | |
| 2573 #ifdef HAVE_SOCKETS | |
| 2574 Fprovide (intern ("network-streams")); | |
| 2575 #ifdef HAVE_MULTICAST | |
| 2576 Fprovide (intern ("multicast")); | |
| 2577 #endif /* HAVE_MULTICAST */ | |
| 2578 #endif /* HAVE_SOCKETS */ | |
| 2579 staticpro (&Vprocess_list); | |
| 2580 | |
| 2581 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /* | |
| 2582 *Non-nil means delete processes immediately when they exit. | |
| 2583 nil means don't delete them until `list-processes' is run. | |
| 2584 */ ); | |
| 2585 | |
| 2586 delete_exited_processes = 1; | |
| 2587 | |
| 442 | 2588 DEFVAR_CONST_LISP ("null-device", &Vnull_device /* |
| 2589 Name of the null device, which differs from system to system. | |
| 2590 The null device is a filename that acts as a sink for arbitrary amounts of | |
| 2591 data, which is discarded, or as a source for a zero-length file. | |
| 2592 It is available on all the systems that we currently support, but with | |
| 2593 different names (typically either `/dev/null' or `nul'). | |
| 2594 | |
| 2595 Note that there is also a /dev/zero on most modern Unix versions (including | |
| 2596 Cygwin), which acts like /dev/null when used as a sink, but as a source | |
| 2597 it sends a non-ending stream of zero bytes. It's used most often along | |
| 2598 with memory-mapping. We don't provide a Lisp variable for this because | |
| 2599 the operations needing this are lower level than what ELisp programs | |
| 2600 typically do, and in any case no equivalent exists under native MS Windows. | |
| 2601 */ ); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2602 Vnull_device = build_ascstring (NULL_DEVICE); |
| 442 | 2603 |
| 428 | 2604 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /* |
| 2605 Control type of device used to communicate with subprocesses. | |
| 2606 Values are nil to use a pipe, or t or `pty' to use a pty. | |
| 2607 The value has no effect if the system has no ptys or if all ptys are busy: | |
| 2608 then a pipe is used in any case. | |
| 2609 The value takes effect when `start-process' is called. | |
| 2610 */ ); | |
| 2611 Vprocess_connection_type = Qt; | |
| 2612 | |
| 2613 DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /* | |
| 2614 Enables input/output on standard handles of a windowed process. | |
| 2615 When this variable is nil (the default), XEmacs does not attempt to read | |
| 2616 standard output handle of a windowed process. Instead, the process is | |
| 2617 immediately marked as exited immediately upon successful launching. This is | |
| 2618 done because normal windowed processes do not use standard I/O, as they are | |
| 2619 not connected to any console. | |
| 2620 | |
| 2621 When launching a specially crafted windowed process, which expects to be | |
| 2622 launched by XEmacs, or by other program which pipes its standard input and | |
| 2623 output, this variable must be set to non-nil, in which case XEmacs will | |
| 2624 treat this process just like a console process. | |
| 2625 | |
| 2626 NOTE: You should never set this variable, only bind it. | |
| 2627 | |
| 2628 Only Windows processes can be "windowed" or "console". This variable has no | |
| 2629 effect on UNIX processes, because all UNIX processes are "console". | |
| 2630 */ ); | |
| 2631 windowed_process_io = 0; | |
| 2632 | |
| 771 | 2633 DEFVAR_INT ("debug-process-io", &debug_process_io /* |
| 2634 If non-zero, display data sent to or received from a process. | |
| 2635 */ ); | |
| 2636 debug_process_io = 0; | |
| 2637 | |
| 2638 DEFVAR_LISP ("default-process-coding-system", | |
| 2639 &Vdefault_process_coding_system /* | |
| 2640 Cons of coding systems used for process I/O by default. | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2641 May also be nil, interpreted as (nil . nil). |
| 771 | 2642 The car part is used for reading (decoding) data from a process, and |
| 2643 the cdr part is used for writing (encoding) data to a process. | |
| 2644 */ ); | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2645 /* Better, system-dependent defaults are set in code-init.el. */ |
| 771 | 2646 Vdefault_process_coding_system = Fcons (Qundecided, Qnil); |
| 2647 | |
| 853 | 2648 DEFVAR_LISP ("default-network-coding-system", |
| 2649 &Vdefault_network_coding_system /* | |
| 2650 Cons of coding systems used for network I/O by default. | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2651 May also be nil, interpreted as (nil . nil). |
| 853 | 2652 The car part is used for reading (decoding) data from a process, and |
| 2653 the cdr part is used for writing (encoding) data to a process. | |
| 2654 */ ); | |
| 2655 Vdefault_network_coding_system = Fcons (Qundecided, Qnil); | |
| 2656 | |
| 428 | 2657 #ifdef PROCESS_IO_BLOCKING |
| 2658 DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /* | |
| 2659 List of port numbers or port names to set a blocking I/O mode with connection. | |
| 862 | 2660 Nil value means to set a default (non-blocking) I/O mode. |
| 428 | 2661 The value takes effect when `open-network-stream-internal' is called. |
| 2662 */ ); | |
| 2663 network_stream_blocking_port_list = Qnil; | |
| 2664 #endif /* PROCESS_IO_BLOCKING */ | |
| 814 | 2665 |
| 2666 /* This function can GC */ | |
| 2667 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* | |
| 2668 *File name to load inferior shells from. | |
| 2669 Initialized from the SHELL environment variable. | |
| 2670 */ ); | |
| 428 | 2671 |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2672 /* ben? thinks the format of this variable is "semi-bogus". |
|
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2673 sjt doesn't agree, since it captures a restriction that is |
|
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2674 present in POSIX shells, after all. */ |
| 814 | 2675 DEFVAR_LISP ("process-environment", &Vprocess_environment /* |
| 2676 List of environment variables for subprocesses to inherit. | |
| 2677 Each element should be a string of the form ENVVARNAME=VALUE. | |
| 2678 The environment which Emacs inherits is placed in this variable | |
| 2679 when Emacs starts. | |
| 2680 */ ); | |
| 2681 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2682 Vlisp_EXEC_SUFFIXES = build_ascstring (EXEC_SUFFIXES); |
| 814 | 2683 staticpro (&Vlisp_EXEC_SUFFIXES); |
| 2684 } |