Mercurial > hg > xemacs-beta
annotate src/process.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Tue, 26 Jan 2010 23:22:30 -0600 |
parents | 8b63e21b0436 |
children | 304aebb79cd3 |
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. | |
3025 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005 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 | |
179 finalize_process (void *header, int for_disksave) | |
180 { | |
181 /* #### this probably needs to be tied into the tty event loop */ | |
182 /* #### when there is one */ | |
440 | 183 Lisp_Process *p = (Lisp_Process *) header; |
428 | 184 #ifdef HAVE_WINDOW_SYSTEM |
185 if (!for_disksave) | |
186 { | |
187 debug_process_finalization (p); | |
188 } | |
189 #endif /* HAVE_WINDOW_SYSTEM */ | |
190 | |
191 if (p->process_data) | |
192 { | |
193 MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); | |
194 if (!for_disksave) | |
1726 | 195 xfree (p->process_data, void *); |
428 | 196 } |
197 } | |
198 | |
934 | 199 DEFINE_LRECORD_IMPLEMENTATION ("process", process, |
200 0, /*dumpable-flag*/ | |
201 mark_process, print_process, finalize_process, | |
202 0, 0, process_description, Lisp_Process); | |
428 | 203 |
204 /************************************************************************/ | |
205 /* basic process accessors */ | |
206 /************************************************************************/ | |
207 | |
771 | 208 /* This function returns low-level streams, connected directly to the child |
209 process, rather than en/decoding streams */ | |
428 | 210 void |
853 | 211 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr, |
212 Lisp_Object *errstr) | |
428 | 213 { |
214 assert (p); | |
853 | 215 assert (NILP (p->pipe_instream) || LSTREAMP (p->pipe_instream)); |
216 assert (NILP (p->pipe_outstream) || LSTREAMP (p->pipe_outstream)); | |
217 assert (NILP (p->pipe_errstream) || LSTREAMP (p->pipe_errstream)); | |
428 | 218 *instr = p->pipe_instream; |
219 *outstr = p->pipe_outstream; | |
853 | 220 *errstr = p->pipe_errstream; |
428 | 221 } |
222 | |
853 | 223 /* Given a USID referring to either a process's instream or errstream, |
224 return the associated process. */ | |
440 | 225 Lisp_Process * |
428 | 226 get_process_from_usid (USID usid) |
227 { | |
442 | 228 const void *vval; |
428 | 229 |
230 assert (usid != USID_ERROR && usid != USID_DONTHASH); | |
231 | |
442 | 232 if (gethash ((const void*)usid, usid_to_process, &vval)) |
428 | 233 { |
444 | 234 Lisp_Object process; |
826 | 235 process = VOID_TO_LISP (vval); |
444 | 236 return XPROCESS (process); |
428 | 237 } |
238 else | |
239 return 0; | |
240 } | |
241 | |
242 int | |
853 | 243 get_process_selected_p (Lisp_Process *p, int do_err) |
428 | 244 { |
853 | 245 return do_err ? p->err_selected : p->in_selected; |
428 | 246 } |
247 | |
248 void | |
853 | 249 set_process_selected_p (Lisp_Process *p, int in_selected, int err_selected) |
428 | 250 { |
853 | 251 p->in_selected = !!in_selected; |
252 p->err_selected = !!err_selected; | |
428 | 253 } |
254 | |
255 int | |
440 | 256 connected_via_filedesc_p (Lisp_Process *p) |
428 | 257 { |
258 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); | |
259 } | |
260 | |
261 #ifdef HAVE_SOCKETS | |
262 int | |
263 network_connection_p (Lisp_Object process) | |
264 { | |
265 return CONSP (XPROCESS (process)->pid); | |
266 } | |
267 #endif | |
268 | |
269 DEFUN ("processp", Fprocessp, 1, 1, 0, /* | |
270 Return t if OBJECT is a process. | |
271 */ | |
444 | 272 (object)) |
428 | 273 { |
444 | 274 return PROCESSP (object) ? Qt : Qnil; |
428 | 275 } |
276 | |
440 | 277 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* |
278 Return t if OBJECT is a process that is alive. | |
279 */ | |
444 | 280 (object)) |
440 | 281 { |
444 | 282 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object)) |
283 ? Qt : Qnil; | |
440 | 284 } |
285 | |
863 | 286 #if 0 |
287 /* This is a reasonable definition for this new primitive. Kyle sez: | |
288 | |
289 "The patch looks OK to me except for the creation and exporting of the | |
290 Fprocess_readable_p function. I don't think a new Lisp function | |
291 should be created until we know something actually needs it. If | |
292 we later want to give process-readable-p different semantics it | |
293 may be hard to do it and stay compatible with what we hastily | |
294 create today." | |
295 | |
296 He's right, not yet. Let's discuss the semantics on XEmacs Design | |
297 before enabling this. | |
298 */ | |
299 DEFUN ("process-readable-p", Fprocess_readable_p, 1, 1, 0, /* | |
300 Return t if OBJECT is a process from which input may be available. | |
301 */ | |
302 (object)) | |
303 { | |
304 return PROCESSP (object) && PROCESS_READABLE_P (XPROCESS (object)) | |
305 ? Qt : Qnil; | |
306 } | |
307 #endif | |
308 | |
428 | 309 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* |
310 Return a list of all processes. | |
311 */ | |
312 ()) | |
313 { | |
314 return Fcopy_sequence (Vprocess_list); | |
315 } | |
316 | |
317 DEFUN ("get-process", Fget_process, 1, 1, 0, /* | |
444 | 318 Return the process named PROCESS-NAME (a string), or nil if there is none. |
319 PROCESS-NAME may also be a process; if so, the value is that process. | |
428 | 320 */ |
444 | 321 (process_name)) |
428 | 322 { |
444 | 323 if (PROCESSP (process_name)) |
324 return process_name; | |
428 | 325 |
326 if (!gc_in_progress) | |
327 /* this only gets called during GC when emacs is going away as a result | |
328 of a signal or crash. */ | |
444 | 329 CHECK_STRING (process_name); |
428 | 330 |
444 | 331 { |
332 LIST_LOOP_2 (process, Vprocess_list) | |
333 if (internal_equal (process_name, XPROCESS (process)->name, 0)) | |
334 return process; | |
335 } | |
428 | 336 return Qnil; |
337 } | |
338 | |
339 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* | |
340 Return the (or, a) process associated with BUFFER. | |
341 BUFFER may be a buffer or the name of one. | |
342 */ | |
444 | 343 (buffer)) |
428 | 344 { |
444 | 345 if (NILP (buffer)) return Qnil; |
346 buffer = Fget_buffer (buffer); | |
347 if (NILP (buffer)) return Qnil; | |
428 | 348 |
444 | 349 { |
350 LIST_LOOP_2 (process, Vprocess_list) | |
351 if (EQ (XPROCESS (process)->buffer, buffer)) | |
352 return process; | |
353 } | |
428 | 354 return Qnil; |
355 } | |
356 | |
357 /* This is how commands for the user decode process arguments. It | |
358 accepts a process, a process name, a buffer, a buffer name, or nil. | |
359 Buffers denote the first process in the buffer, and nil denotes the | |
360 current buffer. */ | |
361 | |
362 static Lisp_Object | |
363 get_process (Lisp_Object name) | |
364 { | |
444 | 365 Lisp_Object buffer; |
428 | 366 |
367 #ifdef I18N3 | |
368 /* #### Look more closely into translating process names. */ | |
369 #endif | |
370 | |
371 /* This may be called during a GC from process_send_signal() from | |
2500 | 372 kill_buffer_processes() if emacs decides to ABORT(). */ |
428 | 373 if (PROCESSP (name)) |
374 return name; | |
444 | 375 else if (STRINGP (name)) |
428 | 376 { |
444 | 377 Lisp_Object object = Fget_process (name); |
378 if (PROCESSP (object)) | |
379 return object; | |
380 | |
381 buffer = Fget_buffer (name); | |
382 if (BUFFERP (buffer)) | |
383 goto have_buffer_object; | |
384 | |
563 | 385 invalid_argument ("Process does not exist", name); |
428 | 386 } |
387 else if (NILP (name)) | |
444 | 388 { |
389 buffer = Fcurrent_buffer (); | |
390 goto have_buffer_object; | |
391 } | |
392 else if (BUFFERP (name)) | |
393 { | |
394 Lisp_Object process; | |
395 buffer = name; | |
428 | 396 |
444 | 397 have_buffer_object: |
398 process = Fget_buffer_process (buffer); | |
399 if (PROCESSP (process)) | |
400 return process; | |
401 | |
563 | 402 invalid_argument ("Buffer has no process", buffer); |
428 | 403 } |
404 else | |
444 | 405 return get_process (Fsignal (Qwrong_type_argument, |
771 | 406 (list2 (build_msg_string ("process or buffer or nil"), |
444 | 407 name)))); |
428 | 408 } |
409 | |
410 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* | |
411 Return the process id of PROCESS. | |
412 This is the pid of the Unix process which PROCESS uses or talks to. | |
413 For a network connection, this value is a cons of | |
414 (foreign-network-port . foreign-host-name). | |
415 */ | |
444 | 416 (process)) |
428 | 417 { |
418 Lisp_Object pid; | |
444 | 419 CHECK_PROCESS (process); |
428 | 420 |
444 | 421 pid = XPROCESS (process)->pid; |
422 if (network_connection_p (process)) | |
428 | 423 /* return Qnil; */ |
424 return Fcons (Fcar (pid), Fcdr (pid)); | |
425 else | |
426 return pid; | |
427 } | |
428 | |
429 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* | |
430 Return the name of PROCESS, as a string. | |
431 This is the name of the program invoked in PROCESS, | |
432 possibly modified to make it unique among process names. | |
433 */ | |
444 | 434 (process)) |
428 | 435 { |
444 | 436 CHECK_PROCESS (process); |
437 return XPROCESS (process)->name; | |
428 | 438 } |
439 | |
440 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* | |
441 Return the command that was executed to start PROCESS. | |
442 This is a list of strings, the first string being the program executed | |
443 and the rest of the strings being the arguments given to it. | |
444 */ | |
444 | 445 (process)) |
428 | 446 { |
444 | 447 CHECK_PROCESS (process); |
448 return XPROCESS (process)->command; | |
428 | 449 } |
450 | |
451 | |
452 /************************************************************************/ | |
453 /* creating a process */ | |
454 /************************************************************************/ | |
455 | |
563 | 456 DOESNT_RETURN |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
457 report_process_error (const Ascbyte *reason, Lisp_Object data) |
563 | 458 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
459 report_error_with_errno (Qprocess_error, reason, data); |
563 | 460 } |
461 | |
462 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
463 report_network_error (const Ascbyte *reason, Lisp_Object data) |
563 | 464 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
465 report_error_with_errno (Qnetwork_error, reason, data); |
563 | 466 } |
467 | |
428 | 468 Lisp_Object |
469 make_process_internal (Lisp_Object name) | |
470 { | |
471 Lisp_Object val, name1; | |
472 int i; | |
3017 | 473 Lisp_Process *p = ALLOC_LCRECORD_TYPE (Lisp_Process, &lrecord_process); |
428 | 474 |
1204 | 475 #define MARKED_SLOT(x) p->x = Qnil; |
476 #include "process-slots.h" | |
477 | |
428 | 478 /* If name is already in use, modify it until it is unused. */ |
479 name1 = name; | |
480 for (i = 1; ; i++) | |
481 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
482 Ascbyte suffix[10]; |
428 | 483 Lisp_Object tem = Fget_process (name1); |
484 if (NILP (tem)) | |
485 break; | |
486 sprintf (suffix, "<%d>", i); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
487 name1 = concat2 (name, build_ascstring (suffix)); |
428 | 488 } |
489 name = name1; | |
490 p->name = name; | |
491 | |
492 p->mark = Fmake_marker (); | |
853 | 493 p->stderr_mark = Fmake_marker (); |
428 | 494 p->status_symbol = Qrun; |
495 | |
496 MAYBE_PROCMETH (alloc_process_data, (p)); | |
497 | |
793 | 498 val = wrap_process (p); |
428 | 499 |
500 Vprocess_list = Fcons (val, Vprocess_list); | |
501 return val; | |
502 } | |
503 | |
504 void | |
853 | 505 init_process_io_handles (Lisp_Process *p, void* in, void* out, void* err, |
506 int flags) | |
428 | 507 { |
853 | 508 USID in_usid, err_usid; |
771 | 509 Lisp_Object incode, outcode; |
510 | |
853 | 511 if (flags & STREAM_NETWORK_CONNECTION) |
512 { | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
513 if (!LISTP (Vdefault_network_coding_system) || |
853 | 514 NILP (incode = (find_coding_system_for_text_file |
515 (Fcar (Vdefault_network_coding_system), 1))) || | |
516 NILP (outcode = (find_coding_system_for_text_file | |
517 (Fcdr (Vdefault_network_coding_system), 0)))) | |
518 signal_error (Qinvalid_state, | |
519 "Bogus value for `default-network-coding-system'", | |
520 Vdefault_network_coding_system); | |
521 } | |
522 else | |
523 { | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
524 if (!LISTP (Vdefault_process_coding_system) || |
853 | 525 NILP (incode = (find_coding_system_for_text_file |
526 (Fcar (Vdefault_process_coding_system), 1))) || | |
527 NILP (outcode = (find_coding_system_for_text_file | |
528 (Fcdr (Vdefault_process_coding_system), 0)))) | |
529 signal_error (Qinvalid_state, | |
530 "Bogus value for `default-process-coding-system'", | |
531 Vdefault_process_coding_system); | |
532 } | |
771 | 533 |
784 | 534 if (!NILP (Vcoding_system_for_read) && |
535 NILP (incode = (find_coding_system_for_text_file | |
536 (Vcoding_system_for_read, 1)))) | |
537 signal_error (Qinvalid_state, | |
538 "Bogus value for `coding-system-for-read'", | |
539 Vcoding_system_for_read); | |
540 | |
541 if (!NILP (Vcoding_system_for_write) && | |
542 NILP (outcode = (find_coding_system_for_text_file | |
543 (Vcoding_system_for_write, 0)))) | |
544 signal_error (Qinvalid_state, | |
545 "Bogus value for `coding-system-for-write'", | |
546 Vcoding_system_for_write); | |
547 | |
853 | 548 event_stream_create_io_streams (in, out, err, |
549 &p->pipe_instream, | |
550 &p->pipe_outstream, | |
551 &p->pipe_errstream, | |
552 &in_usid, &err_usid, | |
553 flags); | |
428 | 554 |
853 | 555 if (in_usid == USID_ERROR || err_usid == USID_ERROR) |
563 | 556 signal_error (Qprocess_error, "Setting up communication with subprocess", |
853 | 557 wrap_process (p)); |
428 | 558 |
853 | 559 if (in_usid != USID_DONTHASH) |
428 | 560 { |
444 | 561 Lisp_Object process = Qnil; |
793 | 562 process = wrap_process (p); |
853 | 563 puthash ((const void*) in_usid, LISP_TO_VOID (process), usid_to_process); |
428 | 564 } |
565 | |
853 | 566 if (err_usid != USID_DONTHASH) |
567 { | |
568 Lisp_Object process = Qnil; | |
569 process = wrap_process (p); | |
570 puthash ((const void*) err_usid, LISP_TO_VOID (process), | |
571 usid_to_process); | |
572 } | |
573 | |
574 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, err, flags)); | |
428 | 575 |
771 | 576 p->coding_instream = |
800 | 577 make_coding_input_stream (XLSTREAM (p->pipe_instream), incode, |
578 CODING_DECODE, 0); | |
853 | 579 if (!NILP (p->pipe_errstream)) |
580 p->coding_errstream = | |
581 make_coding_input_stream | |
582 (XLSTREAM (p->pipe_errstream), incode, CODING_DECODE, 0); | |
771 | 583 p->coding_outstream = |
800 | 584 make_coding_output_stream (XLSTREAM (p->pipe_outstream), outcode, |
585 CODING_ENCODE, 0); | |
428 | 586 } |
587 | |
588 static void | |
589 create_process (Lisp_Object process, Lisp_Object *argv, int nargv, | |
853 | 590 Lisp_Object program, Lisp_Object cur_dir, |
591 int separate_err) | |
428 | 592 { |
440 | 593 Lisp_Process *p = XPROCESS (process); |
428 | 594 int pid; |
595 | |
596 /* *_create_process may change status_symbol, if the process | |
597 is a kind of "fire-and-forget" (no I/O, unwaitable) */ | |
598 p->status_symbol = Qrun; | |
599 p->exit_code = 0; | |
600 | |
853 | 601 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir, |
602 separate_err)); | |
428 | 603 |
604 p->pid = make_int (pid); | |
863 | 605 if (PROCESS_READABLE_P (p)) |
853 | 606 event_stream_select_process (p, 1, 1); |
428 | 607 } |
608 | |
609 /* This function is the unwind_protect form for Fstart_process_internal. If | |
444 | 610 PROCESS doesn't have its pid set, then we know someone has signalled |
428 | 611 an error and the process wasn't started successfully, so we should |
612 remove it from the process list. */ | |
444 | 613 static void remove_process (Lisp_Object process); |
428 | 614 static Lisp_Object |
444 | 615 start_process_unwind (Lisp_Object process) |
428 | 616 { |
444 | 617 /* Was PROCESS started successfully? */ |
618 if (EQ (XPROCESS (process)->pid, Qnil)) | |
619 remove_process (process); | |
428 | 620 return Qnil; |
621 } | |
622 | |
623 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* | |
853 | 624 Internal function to start a program in a subprocess. |
625 Lisp callers should use `start-process' instead. | |
626 | |
627 Returns the process object for it. | |
428 | 628 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS |
629 NAME is name for process. It is modified if necessary to make it unique. | |
630 BUFFER is the buffer or (buffer-name) to associate with the process. | |
631 Process output goes at end of that buffer, unless you specify | |
632 an output stream or filter function to handle the output. | |
633 BUFFER may be also nil, meaning that this process is not associated | |
853 | 634 with any buffer. |
635 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
636 REAL-BUFFER says what to do with standard output, as above, | |
637 while STDERR-BUFFER says what to do with standard error in the child. | |
638 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
639 filter is set). Note that if you do not use this form at process creation, | |
640 stdout and stderr will be mixed in the output buffer, and this cannot be | |
641 changed, even by setting a stderr filter. | |
428 | 642 Third arg is program file name. It is searched for as in the shell. |
643 Remaining arguments are strings to give program as arguments. | |
853 | 644 |
645 Read and write coding systems for the process are determined from | |
646 `coding-system-for-read' and `coding-system-for-write' (intended as | |
647 overriding coding systems to be *bound* by Lisp code, not set), or | |
648 from `default-process-coding-system' if either or both are nil. You can | |
649 change the coding systems later on using `set-process-coding-system', | |
650 `set-process-input-coding-system', or `set-process-output-coding-system'. | |
651 | |
652 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
|
653 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
654 arguments: (NAME BUFFER PROGRAM &rest PROGRAM-ARGS) |
428 | 655 */ |
656 (int nargs, Lisp_Object *args)) | |
657 { | |
658 /* This function can call lisp */ | |
853 | 659 Lisp_Object buffer, stderr_buffer, name, program, process, current_dir; |
660 int separate_stderr; | |
428 | 661 Lisp_Object tem; |
910 | 662 int i; |
428 | 663 int speccount = specpdl_depth (); |
664 struct gcpro gcpro1, gcpro2, gcpro3; | |
665 | |
666 name = args[0]; | |
667 buffer = args[1]; | |
668 program = args[2]; | |
669 current_dir = Qnil; | |
670 | |
671 /* Protect against various file handlers doing GCs below. */ | |
672 GCPRO3 (buffer, program, current_dir); | |
673 | |
853 | 674 if (CONSP (buffer)) |
675 { | |
676 if (!CONSP (XCDR (buffer))) | |
677 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
678 buffer); | |
679 if (!NILP (XCDR (XCDR (buffer)))) | |
680 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
681 buffer); | |
682 stderr_buffer = XCAR (XCDR (buffer)); | |
683 buffer = XCAR (buffer); | |
684 separate_stderr = 1; | |
685 } | |
686 else | |
687 { | |
688 stderr_buffer = Qnil; | |
689 separate_stderr = 0; | |
690 } | |
691 | |
428 | 692 if (!NILP (buffer)) |
693 buffer = Fget_buffer_create (buffer); | |
853 | 694 if (!NILP (stderr_buffer)) |
695 stderr_buffer = Fget_buffer_create (stderr_buffer); | |
428 | 696 |
697 CHECK_STRING (name); | |
698 CHECK_STRING (program); | |
910 | 699 for (i = 3; i < nargs; ++i) |
700 CHECK_STRING (args[i]); | |
428 | 701 |
702 /* Make sure that the child will be able to chdir to the current | |
502 | 703 buffer's current directory, or its unhandled equivalent. [[ We |
428 | 704 can't just have the child check for an error when it does the |
502 | 705 chdir, since it's in a vfork. ]] -- not any more, we don't use |
706 vfork. -ben | |
428 | 707 |
502 | 708 Note: These calls are spread out to insure that the return values |
709 of the calls (which may be newly-created strings) are properly | |
710 GC-protected. */ | |
428 | 711 current_dir = current_buffer->directory; |
502 | 712 /* If the current dir has no terminating slash, we'll get undesirable |
713 results, so put the slash back. */ | |
714 current_dir = Ffile_name_as_directory (current_dir); | |
428 | 715 current_dir = Funhandled_file_name_directory (current_dir); |
716 current_dir = expand_and_dir_to_file (current_dir, Qnil); | |
717 | |
718 #if 0 /* This loser breaks ange-ftp */ | |
719 /* dmoore - if you re-enable this code, you have to gcprotect | |
720 current_buffer through the above calls. */ | |
721 if (NILP (Ffile_accessible_directory_p (current_dir))) | |
563 | 722 signal_error (Qprocess_error, "Setting current directory", |
723 current_buffer->directory); | |
428 | 724 #endif /* 0 */ |
725 | |
726 /* If program file name is not absolute, search our path for it */ | |
826 | 727 if (!IS_DIRECTORY_SEP (string_byte (program, 0)) |
428 | 728 && !(XSTRING_LENGTH (program) > 1 |
826 | 729 && IS_DEVICE_SEP (string_byte (program, 1)))) |
428 | 730 { |
731 struct gcpro ngcpro1; | |
732 | |
733 tem = Qnil; | |
734 NGCPRO1 (tem); | |
735 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); | |
736 if (NILP (tem)) | |
563 | 737 signal_error (Qprocess_error, "Searching for program", program); |
428 | 738 program = Fexpand_file_name (tem, Qnil); |
739 NUNGCPRO; | |
740 } | |
741 else | |
742 { | |
442 | 743 /* we still need to canonicalize it and ensure it has the proper |
744 ending, e.g. .exe */ | |
745 struct gcpro ngcpro1; | |
746 | |
747 tem = Qnil; | |
748 NGCPRO1 (tem); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
749 locate_file (list1 (build_ascstring ("")), program, Vlisp_EXEC_SUFFIXES, |
442 | 750 &tem, X_OK); |
751 if (NILP (tem)) | |
563 | 752 signal_error (Qprocess_error, "Searching for program", program); |
442 | 753 program = tem; |
754 NUNGCPRO; | |
428 | 755 } |
756 | |
442 | 757 if (!NILP (Ffile_directory_p (program))) |
758 invalid_operation ("Specified program for new process is a directory", | |
759 program); | |
760 | |
444 | 761 process = make_process_internal (name); |
428 | 762 |
444 | 763 XPROCESS (process)->buffer = buffer; |
853 | 764 XPROCESS (process)->stderr_buffer = stderr_buffer; |
765 XPROCESS (process)->separate_stderr = separate_stderr; | |
814 | 766 XPROCESS (process)->command = Flist (nargs - 2, args + 2); |
428 | 767 |
768 /* Make the process marker point into the process buffer (if any). */ | |
769 if (!NILP (buffer)) | |
444 | 770 Fset_marker (XPROCESS (process)->mark, |
428 | 771 make_int (BUF_ZV (XBUFFER (buffer))), buffer); |
853 | 772 if (!NILP (stderr_buffer)) |
773 Fset_marker (XPROCESS (process)->stderr_mark, | |
774 make_int (BUF_ZV (XBUFFER (stderr_buffer))), stderr_buffer); | |
428 | 775 |
776 /* If an error occurs and we can't start the process, we want to | |
777 remove it from the process list. This means that each error | |
778 check in create_process doesn't need to call remove_process | |
779 itself; it's all taken care of here. */ | |
444 | 780 record_unwind_protect (start_process_unwind, process); |
428 | 781 |
853 | 782 create_process (process, args + 3, nargs - 3, program, current_dir, |
783 separate_stderr); | |
428 | 784 |
785 UNGCPRO; | |
771 | 786 return unbind_to_1 (speccount, process); |
428 | 787 } |
788 | |
789 | |
790 #ifdef HAVE_SOCKETS | |
791 | |
792 | |
793 /* #### The network support is fairly synthetical. What we actually | |
794 need is a single function, which supports all datagram, stream and | |
795 packet stream connections, arbitrary protocol families should they | |
796 be supported by the target system, multicast groups, in both data | |
797 and control rooted/nonrooted flavors, service quality etc whatever | |
798 is supported by the underlying network. | |
799 | |
800 It must accept a property list describing the connection. The current | |
801 functions must then go to lisp and provide a suitable list for the | |
802 generalized connection function. | |
803 | |
804 Both UNIX and Win32 support BSD sockets, and there are many extensions | |
805 available (Sockets 2 spec). | |
806 | |
807 A todo is define a consistent set of properties abstracting a | |
808 network connection. -kkm | |
809 */ | |
810 | |
811 | |
812 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
813 exactly like a normal process when reading and writing. Only | |
814 differences are in status display and process deletion. A network | |
815 connection has no PID; you cannot signal it. All you can do is | |
816 deactivate and close it via delete-process */ | |
817 | |
442 | 818 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, |
819 0, /* | |
428 | 820 Open a TCP connection for a service to a host. |
444 | 821 Return a process object to represent the connection. |
428 | 822 Input and output work as for subprocesses; `delete-process' closes it. |
823 | |
824 NAME is name for process. It is modified if necessary to make it unique. | |
825 BUFFER is the buffer (or buffer-name) to associate with the process. | |
826 Process output goes at end of that buffer, unless you specify | |
827 an output stream or filter function to handle the output. | |
828 BUFFER may also be nil, meaning that this process is not associated | |
829 with any buffer. | |
444 | 830 Third arg HOST (a string) is the name of the host to connect to, |
831 or its IP address. | |
832 Fourth arg SERVICE is the name of the service desired (a string), | |
833 or an integer specifying a port number to connect to. | |
3025 | 834 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' |
835 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are | |
836 supported. When omitted, `tcp' is assumed. | |
428 | 837 |
442 | 838 Output via `process-send-string' and input via buffer or filter (see |
428 | 839 `set-process-filter') are stream-oriented. That means UDP datagrams are |
840 not guaranteed to be sent and received in discrete packets. (But small | |
841 datagrams around 500 bytes that are not truncated by `process-send-string' | |
444 | 842 are usually fine.) Note further that the UDP protocol does not guard |
843 against lost packets. | |
428 | 844 */ |
845 (name, buffer, host, service, protocol)) | |
846 { | |
847 /* This function can GC */ | |
444 | 848 Lisp_Object process = Qnil; |
428 | 849 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; |
850 void *inch, *outch; | |
851 | |
852 GCPRO5 (name, buffer, host, service, protocol); | |
853 CHECK_STRING (name); | |
854 | |
771 | 855 if (NILP (protocol)) |
428 | 856 protocol = Qtcp; |
857 else | |
858 CHECK_SYMBOL (protocol); | |
859 | |
860 /* Since this code is inside HAVE_SOCKETS, existence of | |
861 open_network_stream is mandatory */ | |
862 PROCMETH (open_network_stream, (name, host, service, protocol, | |
863 &inch, &outch)); | |
864 | |
865 if (!NILP (buffer)) | |
866 buffer = Fget_buffer_create (buffer); | |
444 | 867 process = make_process_internal (name); |
868 NGCPRO1 (process); | |
428 | 869 |
444 | 870 XPROCESS (process)->pid = Fcons (service, host); |
871 XPROCESS (process)->buffer = buffer; | |
771 | 872 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
853 | 873 (void *) -1, |
428 | 874 STREAM_NETWORK_CONNECTION); |
875 | |
853 | 876 event_stream_select_process (XPROCESS (process), 1, 1); |
428 | 877 |
1204 | 878 NUNGCPRO; |
428 | 879 UNGCPRO; |
444 | 880 return process; |
428 | 881 } |
882 | |
883 #ifdef HAVE_MULTICAST | |
884 | |
885 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* | |
886 Open a multicast connection on the specified dest/port/ttl. | |
444 | 887 Return a process object to represent the connection. |
428 | 888 Input and output work as for subprocesses; `delete-process' closes it. |
889 | |
890 NAME is name for process. It is modified if necessary to make it unique. | |
891 BUFFER is the buffer (or buffer-name) to associate with the process. | |
892 Process output goes at end of that buffer, unless you specify | |
893 an output stream or filter function to handle the output. | |
894 BUFFER may also be nil, meaning that this process is not associated | |
895 with any buffer. | |
896 Third, fourth and fifth args are the multicast destination group, port and ttl. | |
897 dest must be an internet address between 224.0.0.0 and 239.255.255.255 | |
898 port is a communication port like in traditional unicast | |
899 ttl is the time-to-live (15 for site, 63 for region and 127 for world) | |
900 */ | |
901 (name, buffer, dest, port, ttl)) | |
902 { | |
903 /* This function can GC */ | |
444 | 904 Lisp_Object process = Qnil; |
428 | 905 struct gcpro gcpro1; |
906 void *inch, *outch; | |
907 | |
908 CHECK_STRING (name); | |
909 | |
910 /* Since this code is inside HAVE_MULTICAST, existence of | |
771 | 911 open_multicast_group is mandatory */ |
428 | 912 PROCMETH (open_multicast_group, (name, dest, port, ttl, |
913 &inch, &outch)); | |
914 | |
915 if (!NILP (buffer)) | |
916 buffer = Fget_buffer_create (buffer); | |
917 | |
444 | 918 process = make_process_internal (name); |
919 GCPRO1 (process); | |
428 | 920 |
444 | 921 XPROCESS (process)->pid = Fcons (port, dest); |
922 XPROCESS (process)->buffer = buffer; | |
853 | 923 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
924 (void *) -1, | |
428 | 925 STREAM_NETWORK_CONNECTION); |
926 | |
853 | 927 event_stream_select_process (XPROCESS (process), 1, 1); |
428 | 928 |
929 UNGCPRO; | |
444 | 930 return process; |
428 | 931 } |
932 #endif /* HAVE_MULTICAST */ | |
933 | |
934 #endif /* HAVE_SOCKETS */ | |
935 | |
936 Lisp_Object | |
937 canonicalize_host_name (Lisp_Object host) | |
938 { | |
939 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); | |
940 } | |
941 | |
942 | |
943 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* | |
944 Tell PROCESS that it has logical window size HEIGHT and WIDTH. | |
945 */ | |
444 | 946 (process, height, width)) |
428 | 947 { |
444 | 948 CHECK_PROCESS (process); |
428 | 949 CHECK_NATNUM (height); |
950 CHECK_NATNUM (width); | |
951 return | |
444 | 952 MAYBE_INT_PROCMETH (set_window_size, |
953 (XPROCESS (process), XINT (height), XINT (width))) <= 0 | |
428 | 954 ? Qnil : Qt; |
955 } | |
956 | |
957 | |
958 /************************************************************************/ | |
959 /* Process I/O */ | |
960 /************************************************************************/ | |
961 | |
844 | 962 /* Set up PROCESS's buffer for insertion of process data at PROCESS's |
963 mark. | |
964 | |
965 Sets the current buffer to PROCESS's buffer, inhibits read only, | |
966 remembers current point, sets point to PROCESS'S mark, widens if | |
967 necessary. | |
968 */ | |
969 static int | |
853 | 970 process_setup_for_insertion (Lisp_Object process, int read_stderr) |
844 | 971 { |
972 Lisp_Process *p = XPROCESS (process); | |
973 int spec = specpdl_depth (); | |
853 | 974 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; |
975 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
976 struct buffer *buf = XBUFFER (buffer); | |
844 | 977 Charbpos output_pt; |
978 | |
979 if (buf != current_buffer) | |
980 { | |
981 record_unwind_protect (save_current_buffer_restore, | |
982 Fcurrent_buffer ()); | |
983 set_buffer_internal (buf); | |
984 } | |
985 | |
986 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
987 specbind (Qinhibit_read_only, Qt); | |
854 | 988 |
844 | 989 /* Insert new output into buffer |
990 at the current end-of-output marker, | |
991 thus preserving logical ordering of input and output. */ | |
853 | 992 if (XMARKER (mark)->buffer) |
993 output_pt = marker_position (mark); | |
844 | 994 else |
995 output_pt = BUF_ZV (buf); | |
996 | |
997 /* If the output marker is outside of the visible region, save | |
998 the restriction and widen. */ | |
999 if (! (BUF_BEGV (buf) <= output_pt && output_pt <= BUF_ZV (buf))) | |
1000 { | |
1001 record_unwind_protect (save_restriction_restore, | |
1002 save_restriction_save (buf)); | |
1003 Fwiden (wrap_buffer (buf)); | |
1004 } | |
1005 | |
1006 BUF_SET_PT (buf, output_pt); | |
1007 return spec; | |
1008 } | |
1009 | |
428 | 1010 /* Read pending output from the process channel, |
1011 starting with our buffered-ahead character if we have one. | |
1012 Yield number of characters read. | |
1013 | |
1014 This function reads at most 1024 bytes. | |
1015 If you want to read all available subprocess output, | |
1016 you must call it repeatedly until it returns zero. */ | |
1017 | |
1018 Charcount | |
853 | 1019 read_process_output (Lisp_Object process, int read_stderr) |
428 | 1020 { |
1021 /* This function can GC */ | |
1022 Bytecount nbytes, nchars; | |
867 | 1023 Ibyte chars[1025]; |
428 | 1024 Lisp_Object outstream; |
444 | 1025 Lisp_Process *p = XPROCESS (process); |
853 | 1026 Lisp_Object filter = read_stderr ? p->stderr_filter : p->filter; |
1027 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; | |
1028 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
428 | 1029 |
1030 /* If there is a lot of output from the subprocess, the loop in | |
1031 execute_internal_event() might call read_process_output() more | |
1032 than once. If the filter that was executed from one of these | |
1033 calls set the filter to t, we have to stop now. Return -1 rather | |
1034 than 0 so execute_internal_event() doesn't close the process. | |
1035 Really, the loop in execute_internal_event() should check itself | |
1036 for a process-filter change, like in status_notify(); but the | |
1037 struct Lisp_Process is not exported outside of this file. */ | |
863 | 1038 if (!PROCESS_READABLE_P (p)) |
853 | 1039 { |
1040 errno = 0; | |
1041 return -1; /* already closed */ | |
1042 } | |
428 | 1043 |
853 | 1044 if (!NILP (filter) && (p->filter_does_read)) |
428 | 1045 { |
1046 Lisp_Object filter_result; | |
1047 | |
1048 /* Some weird FSFmacs crap here with | |
853 | 1049 Vdeactivate_mark and current_buffer->keymap. |
1050 Some FSF junk with running_asynch_code, to preserve the match | |
1051 data. Not necessary because we don't call process filters | |
1052 asynchronously (i.e. from within QUIT). */ | |
1053 /* Don't catch errors here; we're not in any critical code. */ | |
1054 filter_result = call2 (filter, process, Qnil); | |
428 | 1055 CHECK_INT (filter_result); |
1056 return XINT (filter_result); | |
1057 } | |
1058 | |
853 | 1059 nbytes = Lstream_read (read_stderr ? XLSTREAM (DATA_ERRSTREAM (p)) : |
1060 XLSTREAM (DATA_INSTREAM (p)), chars, | |
771 | 1061 sizeof (chars) - 1); |
428 | 1062 if (nbytes <= 0) return nbytes; |
1063 | |
771 | 1064 if (debug_process_io) |
1065 { | |
1066 chars[nbytes] = '\0'; | |
1067 stderr_out ("Read: %s\n", chars); | |
1068 } | |
1069 | |
1070 /* !!#### if the coding system changed as a result of reading, we | |
1071 need to change the output coding system accordingly. */ | |
428 | 1072 nchars = bytecount_to_charcount (chars, nbytes); |
853 | 1073 outstream = filter; |
428 | 1074 if (!NILP (outstream)) |
1075 { | |
853 | 1076 /* Some FSF junk with running_asynch_code, to preserve the match |
1077 data. Not necessary because we don't call process filters | |
1078 asynchronously (i.e. from within QUIT). */ | |
1079 /* Don't catch errors here; we're not in any critical code. */ | |
1080 call2 (outstream, process, make_string (chars, nbytes)); | |
428 | 1081 return nchars; |
1082 } | |
1083 | |
1084 /* If no filter, write into buffer if it isn't dead. */ | |
853 | 1085 if (!NILP (buffer) && BUFFER_LIVE_P (XBUFFER (buffer))) |
428 | 1086 { |
844 | 1087 struct gcpro gcpro1; |
853 | 1088 struct buffer *buf = XBUFFER (buffer); |
1089 int spec = process_setup_for_insertion (process, read_stderr); | |
428 | 1090 |
844 | 1091 GCPRO1 (process); |
428 | 1092 |
1093 #if 0 | |
1094 /* This screws up initial display of the window. jla */ | |
1095 | |
1096 /* Insert before markers in case we are inserting where | |
1097 the buffer's mark is, and the user's next command is Meta-y. */ | |
1098 buffer_insert_raw_string_1 (buf, -1, chars, | |
1099 nbytes, INSDEL_BEFORE_MARKERS); | |
1100 #else | |
1101 buffer_insert_raw_string (buf, chars, nbytes); | |
1102 #endif | |
1103 | |
853 | 1104 Fset_marker (mark, make_int (BUF_PT (buf)), buffer); |
1105 | |
428 | 1106 MARK_MODELINE_CHANGED; |
844 | 1107 unbind_to (spec); |
428 | 1108 UNGCPRO; |
1109 } | |
1110 return nchars; | |
1111 } | |
853 | 1112 |
1113 int | |
1114 process_has_separate_stderr (Lisp_Object process) | |
1115 { | |
1116 return XPROCESS (process)->separate_stderr; | |
1117 } | |
1118 | |
859 | 1119 DEFUN ("process-has-separate-stderr-p", Fprocess_has_separate_stderr_p, 1, 1, |
1120 0, /* | |
1121 Return non-nil if process has stderr separate from stdout. | |
1122 */ | |
1123 (process)) | |
1124 { | |
1125 CHECK_PROCESS (process); | |
1126 return process_has_separate_stderr (process) ? Qt : Qnil; | |
1127 } | |
1128 | |
428 | 1129 |
1130 /* Sending data to subprocess */ | |
1131 | |
444 | 1132 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it |
428 | 1133 specifies the address of the data. Otherwise, the data comes from the |
1134 object RELOCATABLE (either a string or a buffer). START and LEN | |
1135 specify the offset and length of the data to send. | |
1136 | |
665 | 1137 Note that START and LEN are in Charbpos's if RELOCATABLE is a buffer, |
428 | 1138 and in Bytecounts otherwise. */ |
1139 | |
1140 void | |
444 | 1141 send_process (Lisp_Object process, |
867 | 1142 Lisp_Object relocatable, const Ibyte *nonrelocatable, |
428 | 1143 int start, int len) |
1144 { | |
1145 /* This function can GC */ | |
1146 struct gcpro gcpro1, gcpro2; | |
1147 Lisp_Object lstream = Qnil; | |
1148 | |
444 | 1149 GCPRO2 (process, lstream); |
428 | 1150 |
444 | 1151 if (NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
563 | 1152 invalid_operation ("Process not open for writing", process); |
428 | 1153 |
1154 if (nonrelocatable) | |
1155 lstream = | |
1156 make_fixed_buffer_input_stream (nonrelocatable + start, len); | |
1157 else if (BUFFERP (relocatable)) | |
1158 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), | |
1159 start, start + len, 0); | |
1160 else | |
1161 lstream = make_lisp_string_input_stream (relocatable, start, len); | |
1162 | |
771 | 1163 if (debug_process_io) |
1164 { | |
1165 if (nonrelocatable) | |
1166 stderr_out ("Writing: %s\n", nonrelocatable); | |
1167 else | |
1168 { | |
1169 stderr_out ("Writing: "); | |
1170 print_internal (relocatable, Qexternal_debugging_output, 0); | |
1171 } | |
1172 } | |
1173 | |
444 | 1174 PROCMETH (send_process, (process, XLSTREAM (lstream))); |
428 | 1175 |
1176 UNGCPRO; | |
1177 Lstream_delete (XLSTREAM (lstream)); | |
1178 } | |
1179 | |
1180 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* | |
1181 Return the name of the terminal PROCESS uses, or nil if none. | |
1182 This is the terminal that the process itself reads and writes on, | |
1183 not the name of the pty that Emacs uses to talk with that terminal. | |
1184 */ | |
444 | 1185 (process)) |
428 | 1186 { |
444 | 1187 CHECK_PROCESS (process); |
1204 | 1188 return XPROCESS (process)->tty_name; |
428 | 1189 } |
1190 | |
1191 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* | |
1192 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). | |
2297 | 1193 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
428 | 1194 */ |
444 | 1195 (process, buffer)) |
428 | 1196 { |
444 | 1197 CHECK_PROCESS (process); |
428 | 1198 if (!NILP (buffer)) |
1199 CHECK_BUFFER (buffer); | |
444 | 1200 XPROCESS (process)->buffer = buffer; |
428 | 1201 return buffer; |
1202 } | |
1203 | |
1204 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* | |
1205 Return the buffer PROCESS is associated with. | |
2297 | 1206 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
1207 Set the buffer with `set-process-buffer'. | |
428 | 1208 */ |
444 | 1209 (process)) |
428 | 1210 { |
444 | 1211 CHECK_PROCESS (process); |
1212 return XPROCESS (process)->buffer; | |
428 | 1213 } |
1214 | |
853 | 1215 DEFUN ("set-process-stderr-buffer", Fset_process_stderr_buffer, 2, 2, 0, /* |
2297 | 1216 Output from the stderr of PROCESS is inserted in this buffer unless |
1217 PROCESS has a stderr filter. | |
853 | 1218 Set stderr buffer associated with PROCESS to BUFFER (a buffer, or nil). |
1219 */ | |
1220 (process, buffer)) | |
1221 { | |
1222 CHECK_PROCESS (process); | |
1223 if (!XPROCESS (process)->separate_stderr) | |
1224 invalid_change ("stdout and stderr not separate", process); | |
1225 if (!NILP (buffer)) | |
1226 CHECK_BUFFER (buffer); | |
1227 XPROCESS (process)->stderr_buffer = buffer; | |
1228 return buffer; | |
1229 } | |
1230 | |
1231 DEFUN ("process-stderr-buffer", Fprocess_stderr_buffer, 1, 1, 0, /* | |
1232 Return the stderr buffer PROCESS is associated with. | |
2297 | 1233 Output from the stderr of PROCESS is inserted in this buffer unless PROCESS |
1234 has a stderr filter. Set the buffer with `set-process-stderr-buffer'. | |
853 | 1235 */ |
1236 (process)) | |
1237 { | |
1238 CHECK_PROCESS (process); | |
1239 if (!XPROCESS (process)->separate_stderr) | |
1240 invalid_change ("stdout and stderr not separate", process); | |
1241 return XPROCESS (process)->stderr_buffer; | |
1242 } | |
1243 | |
428 | 1244 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* |
1245 Return the marker for the end of the last output from PROCESS. | |
1246 */ | |
444 | 1247 (process)) |
428 | 1248 { |
444 | 1249 CHECK_PROCESS (process); |
1250 return XPROCESS (process)->mark; | |
428 | 1251 } |
1252 | |
853 | 1253 DEFUN ("process-stderr-mark", Fprocess_stderr_mark, 1, 1, 0, /* |
1254 Return the marker for the end of the last stderr output from PROCESS. | |
1255 */ | |
1256 (process)) | |
1257 { | |
1258 CHECK_PROCESS (process); | |
1259 if (!XPROCESS (process)->separate_stderr) | |
1260 invalid_operation ("stdout and stderr not separate", process); | |
1261 return XPROCESS (process)->stderr_mark; | |
1262 } | |
1263 | |
428 | 1264 void |
853 | 1265 set_process_filter (Lisp_Object process, Lisp_Object filter, |
1266 int filter_does_read, int set_stderr) | |
428 | 1267 { |
444 | 1268 CHECK_PROCESS (process); |
853 | 1269 if (set_stderr && !XPROCESS (process)->separate_stderr) |
1270 invalid_change ("stdout and stderr not separate", process); | |
863 | 1271 if (PROCESS_READABLE_P (XPROCESS (process))) |
853 | 1272 { |
1273 if (EQ (filter, Qt)) | |
1274 event_stream_unselect_process (XPROCESS (process), !set_stderr, | |
1275 set_stderr); | |
1276 else | |
1277 event_stream_select_process (XPROCESS (process), !set_stderr, | |
1278 set_stderr); | |
1279 } | |
428 | 1280 |
853 | 1281 if (set_stderr) |
1282 XPROCESS (process)->stderr_filter = filter; | |
1283 else | |
1284 XPROCESS (process)->filter = filter; | |
444 | 1285 XPROCESS (process)->filter_does_read = filter_does_read; |
428 | 1286 } |
1287 | |
1288 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* | |
1289 Give PROCESS the filter function FILTER; nil means no filter. | |
853 | 1290 t means stop accepting output from the process. (If process was created |
854 | 1291 with |
853 | 1292 When a process has a filter, each time it does output |
1293 the entire string of output is passed to the filter. | |
1294 The filter gets two arguments: the process and the string of output. | |
1295 If the process has a filter, its buffer is not used for output. | |
1296 */ | |
1297 (process, filter)) | |
1298 { | |
1299 set_process_filter (process, filter, 0, 0); | |
1300 return filter; | |
1301 } | |
1302 | |
1303 DEFUN ("set-process-stderr-filter", Fset_process_stderr_filter, 2, 2, 0, /* | |
1304 Give PROCESS the stderr filter function FILTER; nil means no filter. | |
428 | 1305 t means stop accepting output from the process. |
1306 When a process has a filter, each time it does output | |
1307 the entire string of output is passed to the filter. | |
1308 The filter gets two arguments: the process and the string of output. | |
1309 If the process has a filter, its buffer is not used for output. | |
1310 */ | |
444 | 1311 (process, filter)) |
428 | 1312 { |
853 | 1313 set_process_filter (process, filter, 0, 1); |
428 | 1314 return filter; |
1315 } | |
1316 | |
1317 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* | |
1318 Return the filter function of PROCESS; nil if none. | |
1319 See `set-process-filter' for more info on filter functions. | |
1320 */ | |
444 | 1321 (process)) |
428 | 1322 { |
444 | 1323 CHECK_PROCESS (process); |
1324 return XPROCESS (process)->filter; | |
428 | 1325 } |
1326 | |
853 | 1327 DEFUN ("process-stderr-filter", Fprocess_stderr_filter, 1, 1, 0, /* |
1328 Return the filter function of PROCESS; nil if none. | |
1329 See `set-process-stderr-filter' for more info on filter functions. | |
1330 */ | |
1331 (process)) | |
1332 { | |
1333 CHECK_PROCESS (process); | |
1334 if (!XPROCESS (process)->separate_stderr) | |
1335 invalid_operation ("stdout and stderr not separate", process); | |
1336 return XPROCESS (process)->stderr_filter; | |
1337 } | |
1338 | |
442 | 1339 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /* |
1340 Send current contents of the region between START and END as input to PROCESS. | |
444 | 1341 PROCESS may be a process or the name of a process, or a buffer or the |
1342 name of a buffer, in which case the buffer's process is used. If it | |
1343 is nil, the current buffer's process is used. | |
442 | 1344 BUFFER specifies the buffer to look in; if nil, the current buffer is used. |
853 | 1345 If the region is more than 100 or so characters long, it may be sent in |
1346 several chunks. This may happen even for shorter regions. Output | |
444 | 1347 from processes can arrive in between chunks. |
428 | 1348 */ |
442 | 1349 (process, start, end, buffer)) |
428 | 1350 { |
1351 /* This function can GC */ | |
665 | 1352 Charbpos bstart, bend; |
442 | 1353 struct buffer *buf = decode_buffer (buffer, 0); |
428 | 1354 |
793 | 1355 buffer = wrap_buffer (buf); |
444 | 1356 process = get_process (process); |
1357 get_buffer_range_char (buf, start, end, &bstart, &bend, 0); | |
442 | 1358 |
444 | 1359 send_process (process, buffer, 0, bstart, bend - bstart); |
428 | 1360 return Qnil; |
1361 } | |
1362 | |
1363 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* | |
1364 Send PROCESS the contents of STRING as input. | |
444 | 1365 PROCESS may be a process or the name of a process, or a buffer or the |
1366 name of a buffer, in which case the buffer's process is used. If it | |
1367 is nil, the current buffer's process is used. | |
1368 Optional arguments START and END specify part of STRING; see `substring'. | |
1369 If STRING is more than 100 or so characters long, it may be sent in | |
1370 several chunks. This may happen even for shorter strings. Output | |
1371 from processes can arrive in between chunks. | |
428 | 1372 */ |
444 | 1373 (process, string, start, end)) |
428 | 1374 { |
1375 /* This function can GC */ | |
444 | 1376 Bytecount bstart, bend; |
428 | 1377 |
444 | 1378 process = get_process (process); |
428 | 1379 CHECK_STRING (string); |
444 | 1380 get_string_range_byte (string, start, end, &bstart, &bend, |
428 | 1381 GB_HISTORICAL_STRING_BEHAVIOR); |
1382 | |
444 | 1383 send_process (process, string, 0, bstart, bend - bstart); |
428 | 1384 return Qnil; |
1385 } | |
1386 | |
1387 | |
1388 DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* | |
1389 Return PROCESS's input coding system. | |
1390 */ | |
1391 (process)) | |
1392 { | |
1393 process = get_process (process); | |
863 | 1394 CHECK_READABLE_PROCESS (process); |
771 | 1395 return (coding_stream_detected_coding_system |
1396 (XLSTREAM (XPROCESS (process)->coding_instream))); | |
428 | 1397 } |
1398 | |
1399 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* | |
1400 Return PROCESS's output coding system. | |
1401 */ | |
1402 (process)) | |
1403 { | |
1404 process = get_process (process); | |
440 | 1405 CHECK_LIVE_PROCESS (process); |
771 | 1406 return (coding_stream_coding_system |
1407 (XLSTREAM (XPROCESS (process)->coding_outstream))); | |
428 | 1408 } |
1409 | |
1410 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* | |
1411 Return a pair of coding-system for decoding and encoding of PROCESS. | |
1412 */ | |
1413 (process)) | |
1414 { | |
1415 process = get_process (process); | |
863 | 1416 CHECK_READABLE_PROCESS (process); |
771 | 1417 return Fcons (coding_stream_detected_coding_system |
428 | 1418 (XLSTREAM (XPROCESS (process)->coding_instream)), |
771 | 1419 coding_stream_coding_system |
428 | 1420 (XLSTREAM (XPROCESS (process)->coding_outstream))); |
1421 } | |
1422 | |
1423 DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system, | |
1424 2, 2, 0, /* | |
1425 Set PROCESS's input coding system to CODESYS. | |
771 | 1426 This is used for reading data from PROCESS. |
428 | 1427 */ |
1428 (process, codesys)) | |
1429 { | |
771 | 1430 codesys = get_coding_system_for_text_file (codesys, 1); |
428 | 1431 process = get_process (process); |
863 | 1432 CHECK_READABLE_PROCESS (process); |
440 | 1433 |
771 | 1434 set_coding_stream_coding_system |
428 | 1435 (XLSTREAM (XPROCESS (process)->coding_instream), codesys); |
1436 return Qnil; | |
1437 } | |
1438 | |
1439 DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system, | |
1440 2, 2, 0, /* | |
1441 Set PROCESS's output coding system to CODESYS. | |
771 | 1442 This is used for writing data to PROCESS. |
428 | 1443 */ |
1444 (process, codesys)) | |
1445 { | |
771 | 1446 codesys = get_coding_system_for_text_file (codesys, 0); |
428 | 1447 process = get_process (process); |
440 | 1448 CHECK_LIVE_PROCESS (process); |
1449 | |
771 | 1450 set_coding_stream_coding_system |
428 | 1451 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); |
1452 return Qnil; | |
1453 } | |
1454 | |
1455 DEFUN ("set-process-coding-system", Fset_process_coding_system, | |
1456 1, 3, 0, /* | |
1457 Set coding-systems of PROCESS to DECODING and ENCODING. | |
440 | 1458 DECODING will be used to decode subprocess output and ENCODING to |
1459 encode subprocess input. | |
428 | 1460 */ |
1461 (process, decoding, encoding)) | |
1462 { | |
1463 if (!NILP (decoding)) | |
1464 Fset_process_input_coding_system (process, decoding); | |
1465 | |
1466 if (!NILP (encoding)) | |
1467 Fset_process_output_coding_system (process, encoding); | |
1468 | |
1469 return Qnil; | |
1470 } | |
1471 | |
1472 | |
1473 /************************************************************************/ | |
1474 /* process status */ | |
1475 /************************************************************************/ | |
1476 | |
1477 static Lisp_Object | |
1478 exec_sentinel_unwind (Lisp_Object datum) | |
1479 { | |
853 | 1480 XPROCESS (XCAR (datum))->sentinel = XCDR (datum); |
1481 free_cons (datum); | |
428 | 1482 return Qnil; |
1483 } | |
1484 | |
1485 static void | |
444 | 1486 exec_sentinel (Lisp_Object process, Lisp_Object reason) |
428 | 1487 { |
1488 /* This function can GC */ | |
1489 int speccount = specpdl_depth (); | |
444 | 1490 Lisp_Process *p = XPROCESS (process); |
428 | 1491 Lisp_Object sentinel = p->sentinel; |
1492 | |
1493 if (NILP (sentinel)) | |
1494 return; | |
1495 | |
1496 /* Some weird FSFmacs crap here with | |
1497 Vdeactivate_mark and current_buffer->keymap */ | |
1498 | |
853 | 1499 /* Some FSF junk with running_asynch_code, to preserve the match |
1500 data. Not necessary because we don't call process filters | |
1501 asynchronously (i.e. from within QUIT). */ | |
1502 | |
428 | 1503 /* Zilch the sentinel while it's running, to avoid recursive invocations; |
853 | 1504 assure that it gets restored no matter how the sentinel exits. |
1505 | |
1506 (#### Why is this necessary? Probably another relic of asynchronous | |
1507 calling of process filters/sentinels.) */ | |
428 | 1508 p->sentinel = Qnil; |
853 | 1509 record_unwind_protect (exec_sentinel_unwind, |
1510 noseeum_cons (process, sentinel)); | |
1511 /* Don't catch errors here; we're not in any critical code. */ | |
1512 call2 (sentinel, process, reason); | |
771 | 1513 unbind_to (speccount); |
428 | 1514 } |
1515 | |
1516 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* | |
1517 Give PROCESS the sentinel SENTINEL; nil for none. | |
1518 The sentinel is called as a function when the process changes state. | |
1519 It gets two arguments: the process, and a string describing the change. | |
1520 */ | |
444 | 1521 (process, sentinel)) |
428 | 1522 { |
444 | 1523 CHECK_PROCESS (process); |
1524 XPROCESS (process)->sentinel = sentinel; | |
428 | 1525 return sentinel; |
1526 } | |
1527 | |
1528 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* | |
1529 Return the sentinel of PROCESS; nil if none. | |
1530 See `set-process-sentinel' for more info on sentinels. | |
1531 */ | |
444 | 1532 (process)) |
428 | 1533 { |
444 | 1534 CHECK_PROCESS (process); |
1535 return XPROCESS (process)->sentinel; | |
428 | 1536 } |
1537 | |
1538 | |
442 | 1539 const char * |
428 | 1540 signal_name (int signum) |
1541 { | |
1542 if (signum >= 0 && signum < NSIG) | |
442 | 1543 return (const char *) sys_siglist[signum]; |
428 | 1544 |
442 | 1545 return (const char *) GETTEXT ("unknown signal"); |
428 | 1546 } |
1547 | |
1548 void | |
1549 update_process_status (Lisp_Object p, | |
1550 Lisp_Object status_symbol, | |
1551 int exit_code, | |
1552 int core_dumped) | |
1553 { | |
1554 XPROCESS (p)->tick++; | |
1555 process_tick++; | |
1556 XPROCESS (p)->status_symbol = status_symbol; | |
1557 XPROCESS (p)->exit_code = exit_code; | |
1558 XPROCESS (p)->core_dumped = core_dumped; | |
1559 } | |
1560 | |
1561 /* Return a string describing a process status list. */ | |
1562 | |
1563 static Lisp_Object | |
440 | 1564 status_message (Lisp_Process *p) |
428 | 1565 { |
1566 Lisp_Object symbol = p->status_symbol; | |
1567 int code = p->exit_code; | |
1568 int coredump = p->core_dumped; | |
1569 Lisp_Object string, string2; | |
1570 | |
1571 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) | |
1572 { | |
1573 string = build_string (signal_name (code)); | |
1574 if (coredump) | |
771 | 1575 string2 = build_msg_string (" (core dumped)\n"); |
428 | 1576 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1577 string2 = build_ascstring ("\n"); |
793 | 1578 set_string_char (string, 0, |
867 | 1579 DOWNCASE (0, string_ichar (string, 0))); |
428 | 1580 return concat2 (string, string2); |
1581 } | |
1582 else if (EQ (symbol, Qexit)) | |
1583 { | |
1584 if (code == 0) | |
771 | 1585 return build_msg_string ("finished\n"); |
428 | 1586 string = Fnumber_to_string (make_int (code)); |
1587 if (coredump) | |
771 | 1588 string2 = build_msg_string (" (core dumped)\n"); |
428 | 1589 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1590 string2 = build_ascstring ("\n"); |
771 | 1591 return concat2 (build_msg_string ("exited abnormally with code "), |
428 | 1592 concat2 (string, string2)); |
1593 } | |
1594 else | |
1595 return Fcopy_sequence (Fsymbol_name (symbol)); | |
1596 } | |
1597 | |
1598 /* Tell status_notify() to check for terminated processes. We do this | |
1599 because on some systems we sometimes miss SIGCHLD calls. (Not sure | |
853 | 1600 why.) This is also used under Mswin. */ |
428 | 1601 |
1602 void | |
1603 kick_status_notify (void) | |
1604 { | |
1605 process_tick++; | |
1606 } | |
1607 | |
1608 | |
1609 /* Report all recent events of a change in process status | |
1610 (either run the sentinel or output a message). | |
1611 This is done while Emacs is waiting for keyboard input. */ | |
1612 | |
1613 void | |
1614 status_notify (void) | |
1615 { | |
1616 /* This function can GC */ | |
1617 Lisp_Object tail = Qnil; | |
1618 Lisp_Object symbol = Qnil; | |
1619 Lisp_Object msg = Qnil; | |
1620 struct gcpro gcpro1, gcpro2, gcpro3; | |
1621 /* process_tick is volatile, so we have to remember it now. | |
444 | 1622 Otherwise, we get a race condition if SIGCHLD happens during |
428 | 1623 this function. |
1624 | |
1625 (Actually, this is not the case anymore. The code to | |
1626 update the process structures has been moved out of the | |
1627 SIGCHLD handler. But for the moment I'm leaving this | |
1628 stuff in -- it can't hurt.) */ | |
1629 int temp_process_tick; | |
1630 | |
1631 MAYBE_PROCMETH (reap_exited_processes, ()); | |
1632 | |
1633 temp_process_tick = process_tick; | |
1634 | |
1635 if (update_tick == temp_process_tick) | |
1636 return; | |
1637 | |
1638 /* We need to gcpro tail; if read_process_output calls a filter | |
1639 which deletes a process and removes the cons to which tail points | |
1640 from Vprocess_alist, and then causes a GC, tail is an unprotected | |
1641 reference. */ | |
1642 GCPRO3 (tail, symbol, msg); | |
1643 | |
1644 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
1645 { | |
444 | 1646 Lisp_Object process = XCAR (tail); |
1647 Lisp_Process *p = XPROCESS (process); | |
428 | 1648 /* p->tick is also volatile. Same thing as above applies. */ |
1649 int this_process_tick; | |
1650 | |
1651 /* #### extra check for terminated processes, in case a SIGCHLD | |
1652 got missed (this seems to happen sometimes, I'm not sure why). | |
1653 */ | |
1654 if (INTP (p->pid)) | |
1655 MAYBE_PROCMETH (update_status_if_terminated, (p)); | |
1656 | |
1657 this_process_tick = p->tick; | |
1658 if (this_process_tick != p->update_tick) | |
1659 { | |
1660 p->update_tick = this_process_tick; | |
1661 | |
1662 /* If process is still active, read any output that remains. */ | |
1663 while (!EQ (p->filter, Qt) | |
853 | 1664 && read_process_output (process, 0) > 0) |
1665 ; | |
1666 while (p->separate_stderr && !EQ (p->stderr_filter, Qt) | |
1667 && read_process_output (process, 1) > 0) | |
428 | 1668 ; |
1669 | |
1670 /* Get the text to use for the message. */ | |
1671 msg = status_message (p); | |
1672 | |
1673 /* If process is terminated, deactivate it or delete it. */ | |
1674 symbol = p->status_symbol; | |
1675 | |
1676 if (EQ (symbol, Qsignal) | |
1677 || EQ (symbol, Qexit)) | |
1678 { | |
1679 if (delete_exited_processes) | |
444 | 1680 remove_process (process); |
428 | 1681 else |
444 | 1682 deactivate_process (process); |
428 | 1683 } |
1684 | |
1685 /* Now output the message suitably. */ | |
1686 if (!NILP (p->sentinel)) | |
444 | 1687 exec_sentinel (process, msg); |
428 | 1688 /* Don't bother with a message in the buffer |
1689 when a process becomes runnable. */ | |
844 | 1690 else if (!EQ (symbol, Qrun) && !NILP (p->buffer) && |
1691 /* Avoid error if buffer is deleted | |
1692 (probably that's why the process is dead, too) */ | |
1693 BUFFER_LIVE_P (XBUFFER (p->buffer))) | |
428 | 1694 { |
844 | 1695 struct gcpro ngcpro1; |
853 | 1696 int spec = process_setup_for_insertion (process, 0); |
428 | 1697 |
844 | 1698 NGCPRO1 (process); |
428 | 1699 buffer_insert_c_string (current_buffer, "\nProcess "); |
1700 Finsert (1, &p->name); | |
1701 buffer_insert_c_string (current_buffer, " "); | |
1702 Finsert (1, &msg); | |
1703 Fset_marker (p->mark, make_int (BUF_PT (current_buffer)), | |
1704 p->buffer); | |
1705 | |
844 | 1706 unbind_to (spec); |
428 | 1707 NUNGCPRO; |
1708 } | |
1709 } | |
1710 } /* end for */ | |
1711 | |
1712 /* in case buffers use %s in modeline-format */ | |
1713 MARK_MODELINE_CHANGED; | |
1714 redisplay (); | |
1715 | |
1716 update_tick = temp_process_tick; | |
1717 | |
1718 UNGCPRO; | |
1719 } | |
1720 | |
1721 DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* | |
1722 Return the status of PROCESS. | |
1723 This is a symbol, one of these: | |
1724 | |
1725 run -- for a process that is running. | |
1726 stop -- for a process stopped but continuable. | |
1727 exit -- for a process that has exited. | |
1728 signal -- for a process that has got a fatal signal. | |
1729 open -- for a network stream connection that is open. | |
1730 closed -- for a network stream connection that is closed. | |
1731 nil -- if arg is a process name and no such process exists. | |
1732 | |
1733 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
1734 nil, indicating the current buffer's process. | |
1735 */ | |
444 | 1736 (process)) |
428 | 1737 { |
1738 Lisp_Object status_symbol; | |
1739 | |
444 | 1740 if (STRINGP (process)) |
1741 process = Fget_process (process); | |
428 | 1742 else |
444 | 1743 process = get_process (process); |
428 | 1744 |
444 | 1745 if (NILP (process)) |
428 | 1746 return Qnil; |
1747 | |
444 | 1748 status_symbol = XPROCESS (process)->status_symbol; |
1749 if (network_connection_p (process)) | |
428 | 1750 { |
1751 if (EQ (status_symbol, Qrun)) | |
1752 status_symbol = Qopen; | |
1753 else if (EQ (status_symbol, Qexit)) | |
1754 status_symbol = Qclosed; | |
1755 } | |
1756 return status_symbol; | |
1757 } | |
1758 | |
1759 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* | |
1760 Return the exit status of PROCESS or the signal number that killed it. | |
1761 If PROCESS has not yet exited or died, return 0. | |
1762 */ | |
444 | 1763 (process)) |
428 | 1764 { |
444 | 1765 CHECK_PROCESS (process); |
1766 return make_int (XPROCESS (process)->exit_code); | |
428 | 1767 } |
1768 | |
1769 | |
1770 | |
442 | 1771 static int |
1772 decode_signal (Lisp_Object signal_) | |
428 | 1773 { |
442 | 1774 if (INTP (signal_)) |
1775 return XINT (signal_); | |
428 | 1776 else |
1777 { | |
867 | 1778 Ibyte *name; |
428 | 1779 |
442 | 1780 CHECK_SYMBOL (signal_); |
793 | 1781 name = XSTRING_DATA (XSYMBOL (signal_)->name); |
428 | 1782 |
793 | 1783 #define handle_signal(sym) do { \ |
2367 | 1784 if (!qxestrcmp_ascii ( name, #sym)) \ |
793 | 1785 return sym; \ |
442 | 1786 } while (0) |
428 | 1787 |
1788 handle_signal (SIGINT); /* ANSI */ | |
1789 handle_signal (SIGILL); /* ANSI */ | |
1790 handle_signal (SIGABRT); /* ANSI */ | |
1791 handle_signal (SIGFPE); /* ANSI */ | |
1792 handle_signal (SIGSEGV); /* ANSI */ | |
1793 handle_signal (SIGTERM); /* ANSI */ | |
1794 | |
1795 #ifdef SIGHUP | |
1796 handle_signal (SIGHUP); /* POSIX */ | |
1797 #endif | |
1798 #ifdef SIGQUIT | |
1799 handle_signal (SIGQUIT); /* POSIX */ | |
1800 #endif | |
1801 #ifdef SIGTRAP | |
1802 handle_signal (SIGTRAP); /* POSIX */ | |
1803 #endif | |
1804 #ifdef SIGKILL | |
1805 handle_signal (SIGKILL); /* POSIX */ | |
1806 #endif | |
1807 #ifdef SIGUSR1 | |
1808 handle_signal (SIGUSR1); /* POSIX */ | |
1809 #endif | |
1810 #ifdef SIGUSR2 | |
1811 handle_signal (SIGUSR2); /* POSIX */ | |
1812 #endif | |
1813 #ifdef SIGPIPE | |
1814 handle_signal (SIGPIPE); /* POSIX */ | |
1815 #endif | |
1816 #ifdef SIGALRM | |
1817 handle_signal (SIGALRM); /* POSIX */ | |
1818 #endif | |
1819 #ifdef SIGCHLD | |
1820 handle_signal (SIGCHLD); /* POSIX */ | |
1821 #endif | |
1822 #ifdef SIGCONT | |
1823 handle_signal (SIGCONT); /* POSIX */ | |
1824 #endif | |
1825 #ifdef SIGSTOP | |
1826 handle_signal (SIGSTOP); /* POSIX */ | |
1827 #endif | |
1828 #ifdef SIGTSTP | |
1829 handle_signal (SIGTSTP); /* POSIX */ | |
1830 #endif | |
1831 #ifdef SIGTTIN | |
1832 handle_signal (SIGTTIN); /* POSIX */ | |
1833 #endif | |
1834 #ifdef SIGTTOU | |
1835 handle_signal (SIGTTOU); /* POSIX */ | |
1836 #endif | |
1837 | |
1838 #ifdef SIGBUS | |
1839 handle_signal (SIGBUS); /* XPG5 */ | |
1840 #endif | |
1841 #ifdef SIGPOLL | |
1842 handle_signal (SIGPOLL); /* XPG5 */ | |
1843 #endif | |
1844 #ifdef SIGPROF | |
1845 handle_signal (SIGPROF); /* XPG5 */ | |
1846 #endif | |
1847 #ifdef SIGSYS | |
1848 handle_signal (SIGSYS); /* XPG5 */ | |
1849 #endif | |
1850 #ifdef SIGURG | |
1851 handle_signal (SIGURG); /* XPG5 */ | |
1852 #endif | |
1853 #ifdef SIGXCPU | |
1854 handle_signal (SIGXCPU); /* XPG5 */ | |
1855 #endif | |
1856 #ifdef SIGXFSZ | |
1857 handle_signal (SIGXFSZ); /* XPG5 */ | |
1858 #endif | |
1859 #ifdef SIGVTALRM | |
1860 handle_signal (SIGVTALRM); /* XPG5 */ | |
1861 #endif | |
1862 | |
1863 #ifdef SIGIO | |
1864 handle_signal (SIGIO); /* BSD 4.2 */ | |
1865 #endif | |
1866 #ifdef SIGWINCH | |
1867 handle_signal (SIGWINCH); /* BSD 4.3 */ | |
1868 #endif | |
1869 | |
1870 #ifdef SIGEMT | |
1871 handle_signal (SIGEMT); | |
1872 #endif | |
1873 #ifdef SIGINFO | |
1874 handle_signal (SIGINFO); | |
1875 #endif | |
1876 #ifdef SIGHWE | |
1877 handle_signal (SIGHWE); | |
1878 #endif | |
1879 #ifdef SIGPRE | |
1880 handle_signal (SIGPRE); | |
1881 #endif | |
1882 #ifdef SIGUME | |
1883 handle_signal (SIGUME); | |
1884 #endif | |
1885 #ifdef SIGDLK | |
1886 handle_signal (SIGDLK); | |
1887 #endif | |
1888 #ifdef SIGCPULIM | |
1889 handle_signal (SIGCPULIM); | |
1890 #endif | |
1891 #ifdef SIGIOT | |
1892 handle_signal (SIGIOT); | |
1893 #endif | |
1894 #ifdef SIGLOST | |
1895 handle_signal (SIGLOST); | |
1896 #endif | |
1897 #ifdef SIGSTKFLT | |
1898 handle_signal (SIGSTKFLT); | |
1899 #endif | |
1900 #ifdef SIGUNUSED | |
1901 handle_signal (SIGUNUSED); | |
1902 #endif | |
1903 #ifdef SIGDANGER | |
1904 handle_signal (SIGDANGER); /* AIX */ | |
1905 #endif | |
1906 #ifdef SIGMSG | |
1907 handle_signal (SIGMSG); | |
1908 #endif | |
1909 #ifdef SIGSOUND | |
1910 handle_signal (SIGSOUND); | |
1911 #endif | |
1912 #ifdef SIGRETRACT | |
1913 handle_signal (SIGRETRACT); | |
1914 #endif | |
1915 #ifdef SIGGRANT | |
1916 handle_signal (SIGGRANT); | |
1917 #endif | |
1918 #ifdef SIGPWR | |
1919 handle_signal (SIGPWR); | |
1920 #endif | |
1921 | |
1922 #undef handle_signal | |
1923 | |
563 | 1924 invalid_constant ("Undefined signal name", signal_); |
1204 | 1925 RETURN_NOT_REACHED (0); |
442 | 1926 } |
1927 } | |
1928 | |
1929 /* Send signal number SIGNO to PROCESS. | |
1930 CURRENT-GROUP non-nil means send signal to the current | |
1931 foreground process group of the process's controlling terminal rather | |
1932 than to the process's own process group. | |
1933 This is used for various commands in shell mode. | |
1934 If NOMSG is zero, insert signal-announcements into process's buffers | |
1935 right away. | |
1936 | |
1937 If we can, we try to signal PROCESS by sending control characters | |
1938 down the pty. This allows us to signal inferiors who have changed | |
1939 their uid, for which kill() would return an EPERM error, or to | |
1940 processes running on another computer through a remote login. */ | |
1941 | |
1942 static void | |
1943 process_send_signal (Lisp_Object process, int signo, | |
1944 int current_group, int nomsg) | |
1945 { | |
1946 /* This function can GC */ | |
444 | 1947 process = get_process (process); |
442 | 1948 |
444 | 1949 if (network_connection_p (process)) |
563 | 1950 invalid_operation ("Network connection is not a subprocess", process); |
444 | 1951 CHECK_LIVE_PROCESS (process); |
442 | 1952 |
444 | 1953 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg)); |
442 | 1954 } |
1955 | |
1956 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /* | |
1957 Send signal SIGNAL to process PROCESS. | |
1958 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
1959 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
1960 nil, indicating the current buffer's process. | |
1961 Third arg CURRENT-GROUP non-nil means send signal to the current | |
1962 foreground process group of the process's controlling terminal rather | |
1963 than to the process's own process group. | |
1964 If the process is a shell that supports job control, this means | |
1965 send the signal to the current subjob rather than the shell. | |
1966 */ | |
1967 (signal_, process, current_group)) | |
1968 { | |
1969 /* This function can GC */ | |
1970 process_send_signal (process, decode_signal (signal_), | |
1971 !NILP (current_group), 0); | |
1972 return process; | |
1973 } | |
1974 | |
1975 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* | |
1976 Interrupt process PROCESS. | |
1977 See function `process-send-signal' for more details on usage. | |
1978 */ | |
1979 (process, current_group)) | |
1980 { | |
1981 /* This function can GC */ | |
1982 process_send_signal (process, SIGINT, !NILP (current_group), 0); | |
1983 return process; | |
1984 } | |
1985 | |
1986 DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* | |
1987 Kill process PROCESS. | |
1988 See function `process-send-signal' for more details on usage. | |
1989 */ | |
1990 (process, current_group)) | |
1991 { | |
1992 /* This function can GC */ | |
1993 #ifdef SIGKILL | |
1994 process_send_signal (process, SIGKILL, !NILP (current_group), 0); | |
1995 #else | |
563 | 1996 signal_error (Qunimplemented, |
1997 "kill-process: Not supported on this system", | |
1998 Qunbound); | |
442 | 1999 #endif |
2000 return process; | |
2001 } | |
2002 | |
2003 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* | |
2004 Send QUIT signal to process PROCESS. | |
2005 See function `process-send-signal' for more details on usage. | |
2006 */ | |
2007 (process, current_group)) | |
2008 { | |
2009 /* This function can GC */ | |
2010 #ifdef SIGQUIT | |
2011 process_send_signal (process, SIGQUIT, !NILP (current_group), 0); | |
2012 #else | |
563 | 2013 signal_error (Qunimplemented, |
2014 "quit-process: Not supported on this system", | |
2015 Qunbound); | |
442 | 2016 #endif |
2017 return process; | |
2018 } | |
2019 | |
2020 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* | |
2021 Stop process PROCESS. | |
2022 See function `process-send-signal' for more details on usage. | |
2023 */ | |
2024 (process, current_group)) | |
2025 { | |
2026 /* This function can GC */ | |
2027 #ifdef SIGTSTP | |
2028 process_send_signal (process, SIGTSTP, !NILP (current_group), 0); | |
2029 #else | |
563 | 2030 signal_error (Qunimplemented, |
2031 "stop-process: Not supported on this system", | |
2032 Qunbound); | |
442 | 2033 #endif |
2034 return process; | |
2035 } | |
2036 | |
2037 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* | |
2038 Continue process PROCESS. | |
2039 See function `process-send-signal' for more details on usage. | |
2040 */ | |
2041 (process, current_group)) | |
2042 { | |
2043 /* This function can GC */ | |
2044 #ifdef SIGCONT | |
2045 process_send_signal (process, SIGCONT, !NILP (current_group), 0); | |
2046 #else | |
563 | 2047 signal_error (Qunimplemented, |
2048 "continue-process: Not supported on this system", | |
2049 Qunbound); | |
442 | 2050 #endif |
2051 return process; | |
2052 } | |
2053 | |
2054 DEFUN ("signal-process", Fsignal_process, 2, 2, | |
2055 "nProcess number: \nnSignal code: ", /* | |
2056 Send the process with process id PID the signal with code SIGNAL. | |
2057 PID must be an integer. The process need not be a child of this Emacs. | |
2058 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
2059 */ | |
2060 (pid, signal_)) | |
2061 { | |
2062 CHECK_INT (pid); | |
2063 | |
428 | 2064 return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, |
442 | 2065 (XINT (pid), decode_signal (signal_)), |
2066 -1)); | |
428 | 2067 } |
2068 | |
2069 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* | |
2070 Make PROCESS see end-of-file in its input. | |
2071 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
2072 nil, indicating the current buffer's process. | |
2073 If PROCESS is a network connection, or is a process communicating | |
2074 through a pipe (as opposed to a pty), then you cannot send any more | |
2075 text to PROCESS after you call this function. | |
2076 */ | |
2077 (process)) | |
2078 { | |
2079 /* This function can GC */ | |
444 | 2080 process = get_process (process); |
428 | 2081 |
2082 /* Make sure the process is really alive. */ | |
444 | 2083 if (! EQ (XPROCESS (process)->status_symbol, Qrun)) |
563 | 2084 invalid_operation ("Process not running", process); |
428 | 2085 |
444 | 2086 if (!MAYBE_INT_PROCMETH (process_send_eof, (process))) |
428 | 2087 { |
444 | 2088 if (!NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
428 | 2089 { |
853 | 2090 USID humpty, dumpty; |
444 | 2091 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process)))); |
853 | 2092 event_stream_delete_io_streams (Qnil, |
2093 XPROCESS (process)->pipe_outstream, | |
2094 Qnil, &humpty, &dumpty); | |
444 | 2095 XPROCESS (process)->pipe_outstream = Qnil; |
2096 XPROCESS (process)->coding_outstream = Qnil; | |
428 | 2097 } |
2098 } | |
2099 | |
2100 return process; | |
2101 } | |
2102 | |
2103 | |
2104 /************************************************************************/ | |
2105 /* deleting a process */ | |
2106 /************************************************************************/ | |
2107 | |
2108 void | |
444 | 2109 deactivate_process (Lisp_Object process) |
428 | 2110 { |
444 | 2111 Lisp_Process *p = XPROCESS (process); |
853 | 2112 USID in_usid, err_usid; |
428 | 2113 |
2114 /* It's possible that we got as far in the process-creation | |
2115 process as creating the descriptors but didn't get so | |
2116 far as selecting the process for input. In this | |
2117 case, p->pid is nil: p->pid is set at the same time that | |
2118 the process is selected for input. */ | |
2119 /* #### The comment does not look correct. event_stream_unselect_process | |
853 | 2120 is guarded by process->*_selected, so this is not a problem. - kkm*/ |
428 | 2121 /* Must call this before setting the streams to nil */ |
853 | 2122 event_stream_unselect_process (p, 1, 1); |
428 | 2123 |
2124 if (!NILP (DATA_OUTSTREAM (p))) | |
2125 Lstream_close (XLSTREAM (DATA_OUTSTREAM (p))); | |
2126 if (!NILP (DATA_INSTREAM (p))) | |
2127 Lstream_close (XLSTREAM (DATA_INSTREAM (p))); | |
853 | 2128 if (!NILP (DATA_ERRSTREAM (p))) |
2129 Lstream_close (XLSTREAM (DATA_ERRSTREAM (p))); | |
428 | 2130 |
2131 /* Provide minimal implementation for deactivate_process | |
2132 if there's no process-specific one */ | |
2133 if (HAS_PROCMETH_P (deactivate_process)) | |
853 | 2134 PROCMETH (deactivate_process, (p, &in_usid, &err_usid)); |
428 | 2135 else |
853 | 2136 event_stream_delete_io_streams (p->pipe_instream, |
2137 p->pipe_outstream, | |
2138 p->pipe_errstream, | |
2139 &in_usid, &err_usid); | |
428 | 2140 |
853 | 2141 if (in_usid != USID_DONTHASH) |
2367 | 2142 remhash ((const void *) in_usid, usid_to_process); |
853 | 2143 if (err_usid != USID_DONTHASH) |
2367 | 2144 remhash ((const void *) err_usid, usid_to_process); |
428 | 2145 |
2146 p->pipe_instream = Qnil; | |
2147 p->pipe_outstream = Qnil; | |
853 | 2148 p->pipe_errstream = Qnil; |
428 | 2149 p->coding_instream = Qnil; |
2150 p->coding_outstream = Qnil; | |
853 | 2151 p->coding_errstream = Qnil; |
428 | 2152 } |
2153 | |
2154 static void | |
444 | 2155 remove_process (Lisp_Object process) |
428 | 2156 { |
444 | 2157 Vprocess_list = delq_no_quit (process, Vprocess_list); |
428 | 2158 |
444 | 2159 deactivate_process (process); |
428 | 2160 } |
2161 | |
2162 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* | |
2163 Delete PROCESS: kill it and forget about it immediately. | |
2164 PROCESS may be a process or the name of one, or a buffer name. | |
2165 */ | |
444 | 2166 (process)) |
428 | 2167 { |
2168 /* This function can GC */ | |
440 | 2169 Lisp_Process *p; |
444 | 2170 process = get_process (process); |
2171 p = XPROCESS (process); | |
2172 if (network_connection_p (process)) | |
428 | 2173 { |
2174 p->status_symbol = Qexit; | |
2175 p->exit_code = 0; | |
2176 p->core_dumped = 0; | |
2177 p->tick++; | |
2178 process_tick++; | |
2179 } | |
440 | 2180 else if (PROCESS_LIVE_P (p)) |
428 | 2181 { |
444 | 2182 Fkill_process (process, Qnil); |
428 | 2183 /* Do this now, since remove_process will make sigchld_handler do nothing. */ |
2184 p->status_symbol = Qsignal; | |
2185 p->exit_code = SIGKILL; | |
2186 p->core_dumped = 0; | |
2187 p->tick++; | |
2188 process_tick++; | |
2189 status_notify (); | |
2190 } | |
444 | 2191 remove_process (process); |
428 | 2192 return Qnil; |
2193 } | |
2194 | |
2195 /* Kill all processes associated with `buffer'. | |
2196 If `buffer' is nil, kill all processes */ | |
2197 | |
2198 void | |
2199 kill_buffer_processes (Lisp_Object buffer) | |
2200 { | |
444 | 2201 LIST_LOOP_2 (process, Vprocess_list) |
2202 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer))) | |
2203 { | |
2204 if (network_connection_p (process)) | |
2205 Fdelete_process (process); | |
2206 else if (PROCESS_LIVE_P (XPROCESS (process))) | |
2207 process_send_signal (process, SIGHUP, 0, 1); | |
2208 } | |
428 | 2209 } |
2210 | |
2211 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* | |
2212 Say no query needed if PROCESS is running when Emacs is exited. | |
2213 Optional second argument if non-nil says to require a query. | |
2214 Value is t if a query was formerly required. | |
2215 */ | |
444 | 2216 (process, require_query_p)) |
428 | 2217 { |
2218 int tem; | |
2219 | |
444 | 2220 CHECK_PROCESS (process); |
2221 tem = XPROCESS (process)->kill_without_query; | |
2222 XPROCESS (process)->kill_without_query = NILP (require_query_p); | |
428 | 2223 |
2224 return tem ? Qnil : Qt; | |
2225 } | |
2226 | |
2227 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* | |
444 | 2228 Return t if PROCESS will be killed without query when emacs is exited. |
428 | 2229 */ |
444 | 2230 (process)) |
428 | 2231 { |
444 | 2232 CHECK_PROCESS (process); |
2233 return XPROCESS (process)->kill_without_query ? Qt : Qnil; | |
428 | 2234 } |
2235 | |
2236 | |
2237 #if 0 | |
2238 | |
826 | 2239 DEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* |
428 | 2240 Return the connection type of `PROCESS'. This can be nil (pipe), |
2241 t or pty (pty) or stream (socket connection). | |
2242 */ | |
2243 (process)) | |
2244 { | |
2245 return XPROCESS (process)->type; | |
2246 } | |
2247 | |
2248 #endif /* 0 */ | |
2249 | |
814 | 2250 |
2251 static int | |
867 | 2252 getenv_internal (const Ibyte *var, |
814 | 2253 Bytecount varlen, |
867 | 2254 Ibyte **value, |
814 | 2255 Bytecount *valuelen) |
2256 { | |
2257 Lisp_Object scan; | |
2258 | |
2259 assert (env_initted); | |
2260 | |
2261 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
2262 { | |
2263 Lisp_Object entry = XCAR (scan); | |
2264 | |
2265 if (STRINGP (entry) | |
2266 && XSTRING_LENGTH (entry) > varlen | |
826 | 2267 && string_byte (entry, varlen) == '=' |
814 | 2268 #ifdef WIN32_NATIVE |
2269 /* NT environment variables are case insensitive. */ | |
2270 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
2271 #else /* not WIN32_NATIVE */ | |
2272 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
2273 #endif /* not WIN32_NATIVE */ | |
2274 ) | |
2275 { | |
2276 *value = XSTRING_DATA (entry) + (varlen + 1); | |
2277 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); | |
2278 return 1; | |
2279 } | |
2280 } | |
2281 | |
2282 return 0; | |
2283 } | |
2284 | |
2285 static void | |
867 | 2286 putenv_internal (const Ibyte *var, |
814 | 2287 Bytecount varlen, |
867 | 2288 const Ibyte *value, |
814 | 2289 Bytecount valuelen) |
2290 { | |
2291 Lisp_Object scan; | |
2292 | |
2293 assert (env_initted); | |
2294 | |
2295 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
2296 { | |
2297 Lisp_Object entry = XCAR (scan); | |
2298 | |
2299 if (STRINGP (entry) | |
2300 && XSTRING_LENGTH (entry) > varlen | |
826 | 2301 && string_byte (entry, varlen) == '=' |
814 | 2302 #ifdef WIN32_NATIVE |
2303 /* NT environment variables are case insensitive. */ | |
2304 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
2305 #else /* not WIN32_NATIVE */ | |
2306 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
2307 #endif /* not WIN32_NATIVE */ | |
2308 ) | |
2309 { | |
2310 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
|
2311 build_ascstring ("="), |
814 | 2312 make_string (value, valuelen)); |
2313 return; | |
2314 } | |
2315 } | |
2316 | |
2317 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
|
2318 build_ascstring ("="), |
814 | 2319 make_string (value, valuelen)), |
2320 Vprocess_environment); | |
2321 } | |
2322 | |
2323 /* NOTE: | |
2324 | |
2325 FSF has this as a Lisp function, as follows. Generally moving things | |
2326 out of C and into Lisp is a good idea, but in this case the Lisp | |
2327 function is used so early in the startup sequence that it would be ugly | |
2328 to rearrange the early dumped code to accommodate this. | |
854 | 2329 |
814 | 2330 (defun getenv (variable) |
2331 "Get the value of environment variable VARIABLE. | |
2332 VARIABLE should be a string. Value is nil if VARIABLE is undefined in | |
2333 the environment. Otherwise, value is a string. | |
2334 | |
2335 This function consults the variable `process-environment' | |
2336 for its value." | |
2337 (interactive (list (read-envvar-name "Get environment variable: " t))) | |
2338 (let ((value (getenv-internal variable))) | |
2339 (when (interactive-p) | |
2340 (message "%s" (if value value "Not set"))) | |
2341 value)) | |
2342 */ | |
2343 | |
2344 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* | |
2345 Return the value of environment variable VAR, as a string. | |
2346 VAR is a string, the name of the variable. | |
2347 When invoked interactively, prints the value in the echo area. | |
2348 */ | |
2349 (var, interactivep)) | |
2350 { | |
4932 | 2351 Ibyte *value = NULL; |
814 | 2352 Bytecount valuelen; |
2353 Lisp_Object v = Qnil; | |
2354 struct gcpro gcpro1; | |
2355 | |
2356 CHECK_STRING (var); | |
2357 GCPRO1 (v); | |
2358 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var), | |
2359 &value, &valuelen)) | |
2360 v = make_string (value, valuelen); | |
2361 if (!NILP (interactivep)) | |
2362 { | |
2363 if (NILP (v)) | |
2364 message ("%s not defined in environment", XSTRING_DATA (var)); | |
2365 else | |
2366 /* #### Should use Fprin1_to_string or Fprin1 to handle string | |
2367 containing quotes correctly. */ | |
2368 message ("\"%s\"", value); | |
2369 } | |
2370 RETURN_UNGCPRO (v); | |
2371 } | |
2372 | |
2373 /* A version of getenv that consults Vprocess_environment, easily | |
2374 callable from C. | |
2375 | |
2376 (At init time, Vprocess_environment is initialized from the | |
2377 environment, stored in the global variable environ. [Note that | |
2378 at startup time, `environ' should be the same as the envp parameter | |
2379 passed to main(); however, later calls to putenv() may change | |
2380 `environ', making the envp parameter inaccurate.] Calls to getenv() | |
2381 and putenv() consult and modify `environ'. However, once | |
2382 Vprocess_environment is initted, XEmacs C code should *NEVER* call | |
2383 getenv() or putenv() directly, because (1) Lisp code that modifies | |
2384 the environment only modifies Vprocess_environment, not `environ'; | |
2385 and (2) Vprocess_environment is in internal format but `environ' | |
2386 is in some external format, and getenv()/putenv() are not Mule- | |
2387 encapsulated. | |
2388 | |
2389 WARNING: This value points into Lisp string data and thus will become | |
2390 invalid after a GC. */ | |
2391 | |
867 | 2392 Ibyte * |
2393 egetenv (const CIbyte *var) | |
814 | 2394 { |
2395 /* This cannot GC -- 7-28-00 ben */ | |
867 | 2396 Ibyte *value; |
814 | 2397 Bytecount valuelen; |
2398 | |
867 | 2399 if (getenv_internal ((const Ibyte *) var, strlen (var), &value, &valuelen)) |
814 | 2400 return value; |
2401 else | |
2402 return 0; | |
2403 } | |
2404 | |
2405 void | |
867 | 2406 eputenv (const CIbyte *var, const CIbyte *value) |
814 | 2407 { |
867 | 2408 putenv_internal ((Ibyte *) var, strlen (var), (Ibyte *) value, |
814 | 2409 strlen (value)); |
2410 } | |
2411 | |
2412 | |
2413 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ | |
2414 void | |
2415 init_xemacs_process (void) | |
2416 { | |
2417 /* This function can GC */ | |
2418 | |
2419 MAYBE_PROCMETH (init_process, ()); | |
2420 | |
2421 Vprocess_list = Qnil; | |
2422 | |
2423 if (usid_to_process) | |
2424 clrhash (usid_to_process); | |
2425 else | |
2426 usid_to_process = make_hash_table (32); | |
854 | 2427 |
814 | 2428 { |
2429 /* jwz: always initialize Vprocess_environment, so that egetenv() | |
2430 works in temacs. */ | |
2367 | 2431 Extbyte **envp; |
814 | 2432 Vprocess_environment = Qnil; |
2367 | 2433 #ifdef WIN32_NATIVE |
2434 _wgetenv (L""); /* force initialization of _wenviron */ | |
2435 for (envp = (Extbyte **) _wenviron; envp && *envp; envp++) | |
2436 Vprocess_environment = | |
2437 Fcons (build_ext_string (*envp, Qmswindows_unicode), | |
2438 Vprocess_environment); | |
2439 #else | |
814 | 2440 for (envp = environ; envp && *envp; envp++) |
2441 Vprocess_environment = | |
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
|
2442 Fcons (build_ext_string (*envp, Qenvironment_variable_encoding), |
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
|
2443 Vprocess_environment); |
2367 | 2444 #endif |
814 | 2445 /* This gets set back to 0 in disksave_object_finalization() */ |
2446 env_initted = 1; | |
2447 } | |
2448 | |
2449 { | |
2450 /* Initialize shell-file-name from environment variables or best guess. */ | |
2451 #ifdef WIN32_NATIVE | |
867 | 2452 const Ibyte *shell = egetenv ("SHELL"); |
814 | 2453 if (!shell) shell = egetenv ("COMSPEC"); |
2454 /* Should never happen! */ | |
2455 if (!shell) shell = | |
867 | 2456 (Ibyte *) (GetVersion () & 0x80000000 ? "command" : "cmd"); |
814 | 2457 #else /* not WIN32_NATIVE */ |
867 | 2458 const Ibyte *shell = egetenv ("SHELL"); |
2459 if (!shell) shell = (Ibyte *) "/bin/sh"; | |
814 | 2460 #endif |
2461 | |
2462 #if 0 /* defined (WIN32_NATIVE) */ | |
2463 /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created | |
2464 SHELL var down to some inferior Cygwin process, which might get | |
2465 screwed up. | |
854 | 2466 |
814 | 2467 There are a few broken apps (eterm/term.el, eterm/tshell.el, |
2468 os-utils/terminal.el, texinfo/tex-mode.el) where this will | |
2469 cause problems. Those broken apps don't look at | |
2470 shell-file-name, instead just at explicit-shell-file-name, | |
2471 ESHELL and SHELL. They are apparently attempting to borrow | |
2472 what `M-x shell' uses, but that latter also looks at | |
2473 shell-file-name. What we want is for all of these apps to look | |
2474 at shell-file-name, so that the user can change the value of | |
2475 shell-file-name and everything will work out hunky-dorey. | |
2476 */ | |
854 | 2477 |
814 | 2478 if (!egetenv ("SHELL")) |
2479 { | |
2367 | 2480 Ibyte *faux_var = alloca_ibytes (7 + qxestrlen (shell)); |
814 | 2481 qxesprintf (faux_var, "SHELL=%s", shell); |
2482 Vprocess_environment = Fcons (build_intstring (faux_var), | |
2483 Vprocess_environment); | |
2484 } | |
2485 #endif /* 0 */ | |
2486 | |
2487 Vshell_file_name = build_intstring (shell); | |
2488 } | |
2489 } | |
2490 | |
428 | 2491 void |
2492 syms_of_process (void) | |
2493 { | |
442 | 2494 INIT_LRECORD_IMPLEMENTATION (process); |
2495 | |
563 | 2496 DEFSYMBOL (Qprocessp); |
2497 DEFSYMBOL (Qprocess_live_p); | |
2498 DEFSYMBOL (Qrun); | |
2499 DEFSYMBOL (Qstop); | |
2500 DEFSYMBOL (Qopen); | |
2501 DEFSYMBOL (Qclosed); | |
863 | 2502 #if 0 |
2503 /* see comment at Fprocess_readable_p */ | |
2504 DEFSYMBOL (&Qprocess_readable_p); | |
2505 #endif | |
563 | 2506 DEFSYMBOL (Qtcp); |
2507 DEFSYMBOL (Qudp); | |
428 | 2508 |
2509 #ifdef HAVE_MULTICAST | |
563 | 2510 DEFSYMBOL (Qmulticast); /* Used for occasional warnings */ |
428 | 2511 #endif |
2512 | |
563 | 2513 DEFERROR_STANDARD (Qprocess_error, Qio_error); |
2514 DEFERROR_STANDARD (Qnetwork_error, Qio_error); | |
2515 | |
428 | 2516 DEFSUBR (Fprocessp); |
440 | 2517 DEFSUBR (Fprocess_live_p); |
863 | 2518 #if 0 |
2519 /* see comment at Fprocess_readable_p */ | |
2520 DEFSUBR (Fprocess_readable_p); | |
2521 #endif | |
428 | 2522 DEFSUBR (Fget_process); |
2523 DEFSUBR (Fget_buffer_process); | |
2524 DEFSUBR (Fdelete_process); | |
2525 DEFSUBR (Fprocess_status); | |
2526 DEFSUBR (Fprocess_exit_status); | |
2527 DEFSUBR (Fprocess_id); | |
2528 DEFSUBR (Fprocess_name); | |
2529 DEFSUBR (Fprocess_tty_name); | |
2530 DEFSUBR (Fprocess_command); | |
859 | 2531 DEFSUBR (Fprocess_has_separate_stderr_p); |
428 | 2532 DEFSUBR (Fset_process_buffer); |
853 | 2533 DEFSUBR (Fset_process_stderr_buffer); |
428 | 2534 DEFSUBR (Fprocess_buffer); |
2535 DEFSUBR (Fprocess_mark); | |
853 | 2536 DEFSUBR (Fprocess_stderr_buffer); |
2537 DEFSUBR (Fprocess_stderr_mark); | |
428 | 2538 DEFSUBR (Fset_process_filter); |
2539 DEFSUBR (Fprocess_filter); | |
853 | 2540 DEFSUBR (Fset_process_stderr_filter); |
2541 DEFSUBR (Fprocess_stderr_filter); | |
428 | 2542 DEFSUBR (Fset_process_window_size); |
2543 DEFSUBR (Fset_process_sentinel); | |
2544 DEFSUBR (Fprocess_sentinel); | |
2545 DEFSUBR (Fprocess_kill_without_query); | |
2546 DEFSUBR (Fprocess_kill_without_query_p); | |
2547 DEFSUBR (Fprocess_list); | |
2548 DEFSUBR (Fstart_process_internal); | |
2549 #ifdef HAVE_SOCKETS | |
2550 DEFSUBR (Fopen_network_stream_internal); | |
2551 #ifdef HAVE_MULTICAST | |
2552 DEFSUBR (Fopen_multicast_group_internal); | |
2553 #endif /* HAVE_MULTICAST */ | |
2554 #endif /* HAVE_SOCKETS */ | |
2555 DEFSUBR (Fprocess_send_region); | |
2556 DEFSUBR (Fprocess_send_string); | |
442 | 2557 DEFSUBR (Fprocess_send_signal); |
428 | 2558 DEFSUBR (Finterrupt_process); |
2559 DEFSUBR (Fkill_process); | |
2560 DEFSUBR (Fquit_process); | |
2561 DEFSUBR (Fstop_process); | |
2562 DEFSUBR (Fcontinue_process); | |
2563 DEFSUBR (Fprocess_send_eof); | |
2564 DEFSUBR (Fsignal_process); | |
2565 /* DEFSUBR (Fprocess_connection); */ | |
2566 DEFSUBR (Fprocess_input_coding_system); | |
2567 DEFSUBR (Fprocess_output_coding_system); | |
2568 DEFSUBR (Fset_process_input_coding_system); | |
2569 DEFSUBR (Fset_process_output_coding_system); | |
2570 DEFSUBR (Fprocess_coding_system); | |
2571 DEFSUBR (Fset_process_coding_system); | |
814 | 2572 DEFSUBR (Fgetenv); |
428 | 2573 } |
2574 | |
2575 void | |
2576 vars_of_process (void) | |
2577 { | |
2578 Fprovide (intern ("subprocesses")); | |
2579 #ifdef HAVE_SOCKETS | |
2580 Fprovide (intern ("network-streams")); | |
2581 #ifdef HAVE_MULTICAST | |
2582 Fprovide (intern ("multicast")); | |
2583 #endif /* HAVE_MULTICAST */ | |
2584 #endif /* HAVE_SOCKETS */ | |
2585 staticpro (&Vprocess_list); | |
2586 | |
2587 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /* | |
2588 *Non-nil means delete processes immediately when they exit. | |
2589 nil means don't delete them until `list-processes' is run. | |
2590 */ ); | |
2591 | |
2592 delete_exited_processes = 1; | |
2593 | |
442 | 2594 DEFVAR_CONST_LISP ("null-device", &Vnull_device /* |
2595 Name of the null device, which differs from system to system. | |
2596 The null device is a filename that acts as a sink for arbitrary amounts of | |
2597 data, which is discarded, or as a source for a zero-length file. | |
2598 It is available on all the systems that we currently support, but with | |
2599 different names (typically either `/dev/null' or `nul'). | |
2600 | |
2601 Note that there is also a /dev/zero on most modern Unix versions (including | |
2602 Cygwin), which acts like /dev/null when used as a sink, but as a source | |
2603 it sends a non-ending stream of zero bytes. It's used most often along | |
2604 with memory-mapping. We don't provide a Lisp variable for this because | |
2605 the operations needing this are lower level than what ELisp programs | |
2606 typically do, and in any case no equivalent exists under native MS Windows. | |
2607 */ ); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2608 Vnull_device = build_ascstring (NULL_DEVICE); |
442 | 2609 |
428 | 2610 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /* |
2611 Control type of device used to communicate with subprocesses. | |
2612 Values are nil to use a pipe, or t or `pty' to use a pty. | |
2613 The value has no effect if the system has no ptys or if all ptys are busy: | |
2614 then a pipe is used in any case. | |
2615 The value takes effect when `start-process' is called. | |
2616 */ ); | |
2617 Vprocess_connection_type = Qt; | |
2618 | |
2619 DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /* | |
2620 Enables input/output on standard handles of a windowed process. | |
2621 When this variable is nil (the default), XEmacs does not attempt to read | |
2622 standard output handle of a windowed process. Instead, the process is | |
2623 immediately marked as exited immediately upon successful launching. This is | |
2624 done because normal windowed processes do not use standard I/O, as they are | |
2625 not connected to any console. | |
2626 | |
2627 When launching a specially crafted windowed process, which expects to be | |
2628 launched by XEmacs, or by other program which pipes its standard input and | |
2629 output, this variable must be set to non-nil, in which case XEmacs will | |
2630 treat this process just like a console process. | |
2631 | |
2632 NOTE: You should never set this variable, only bind it. | |
2633 | |
2634 Only Windows processes can be "windowed" or "console". This variable has no | |
2635 effect on UNIX processes, because all UNIX processes are "console". | |
2636 */ ); | |
2637 windowed_process_io = 0; | |
2638 | |
771 | 2639 DEFVAR_INT ("debug-process-io", &debug_process_io /* |
2640 If non-zero, display data sent to or received from a process. | |
2641 */ ); | |
2642 debug_process_io = 0; | |
2643 | |
2644 DEFVAR_LISP ("default-process-coding-system", | |
2645 &Vdefault_process_coding_system /* | |
2646 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
|
2647 May also be nil, interpreted as (nil . nil). |
771 | 2648 The car part is used for reading (decoding) data from a process, and |
2649 the cdr part is used for writing (encoding) data to a process. | |
2650 */ ); | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2651 /* Better, system-dependent defaults are set in code-init.el. */ |
771 | 2652 Vdefault_process_coding_system = Fcons (Qundecided, Qnil); |
2653 | |
853 | 2654 DEFVAR_LISP ("default-network-coding-system", |
2655 &Vdefault_network_coding_system /* | |
2656 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
|
2657 May also be nil, interpreted as (nil . nil). |
853 | 2658 The car part is used for reading (decoding) data from a process, and |
2659 the cdr part is used for writing (encoding) data to a process. | |
2660 */ ); | |
2661 Vdefault_network_coding_system = Fcons (Qundecided, Qnil); | |
2662 | |
428 | 2663 #ifdef PROCESS_IO_BLOCKING |
2664 DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /* | |
2665 List of port numbers or port names to set a blocking I/O mode with connection. | |
862 | 2666 Nil value means to set a default (non-blocking) I/O mode. |
428 | 2667 The value takes effect when `open-network-stream-internal' is called. |
2668 */ ); | |
2669 network_stream_blocking_port_list = Qnil; | |
2670 #endif /* PROCESS_IO_BLOCKING */ | |
814 | 2671 |
2672 /* This function can GC */ | |
2673 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* | |
2674 *File name to load inferior shells from. | |
2675 Initialized from the SHELL environment variable. | |
2676 */ ); | |
428 | 2677 |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2678 /* 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
|
2679 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
|
2680 present in POSIX shells, after all. */ |
814 | 2681 DEFVAR_LISP ("process-environment", &Vprocess_environment /* |
2682 List of environment variables for subprocesses to inherit. | |
2683 Each element should be a string of the form ENVVARNAME=VALUE. | |
2684 The environment which Emacs inherits is placed in this variable | |
2685 when Emacs starts. | |
2686 */ ); | |
2687 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2688 Vlisp_EXEC_SUFFIXES = build_ascstring (EXEC_SUFFIXES); |
814 | 2689 staticpro (&Vlisp_EXEC_SUFFIXES); |
2690 } |