Mercurial > hg > xemacs-beta

comparison src/process.c @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 7039e6323819
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
110 Lisp_Object Vnull_device; 110 Lisp_Object Vnull_device;
111 111
112 112
113 113
114 static Lisp_Object 114 static Lisp_Object
115 mark_process (Lisp_Object obj) 115 mark_process (Lisp_Object object)
116 { 116 {
117 Lisp_Process *proc = XPROCESS (obj); 117 Lisp_Process *process = XPROCESS (object);
118 MAYBE_PROCMETH (mark_process_data, (proc)); 118 MAYBE_PROCMETH (mark_process_data, (process));
119 mark_object (proc->name); 119 mark_object (process->name);
120 mark_object (proc->command); 120 mark_object (process->command);
121 mark_object (proc->filter); 121 mark_object (process->filter);
122 mark_object (proc->sentinel); 122 mark_object (process->sentinel);
123 mark_object (proc->buffer); 123 mark_object (process->buffer);
124 mark_object (proc->mark); 124 mark_object (process->mark);
125 mark_object (proc->pid); 125 mark_object (process->pid);
126 mark_object (proc->pipe_instream); 126 mark_object (process->pipe_instream);
127 mark_object (proc->pipe_outstream); 127 mark_object (process->pipe_outstream);
128 #ifdef FILE_CODING 128 #ifdef FILE_CODING
129 mark_object (proc->coding_instream); 129 mark_object (process->coding_instream);
130 mark_object (proc->coding_outstream); 130 mark_object (process->coding_outstream);
131 #endif 131 #endif
132 return proc->status_symbol; 132 return process->status_symbol;
133 } 133 }
134 134
135 static void 135 static void
136 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 136 print_process (Lisp_Object object, Lisp_Object printcharfun, int escapeflag)
137 { 137 {
138 Lisp_Process *proc = XPROCESS (obj); 138 Lisp_Process *process = XPROCESS (object);
139 139
140 if (print_readably) 140 if (print_readably)
141 error ("printing unreadable object #<process %s>", 141 error ("printing unreadable object #<process %s>",
142 XSTRING_DATA (proc->name)); 142 XSTRING_DATA (process->name));
143 143
144 if (!escapeflag) 144 if (!escapeflag)
145 { 145 {
146 print_internal (proc->name, printcharfun, 0); 146 print_internal (process->name, printcharfun, 0);
147 } 147 }
148 else 148 else
149 { 149 {
150 int netp = network_connection_p (obj); 150 int netp = network_connection_p (object);
151 write_c_string ((netp ? GETTEXT ("#<network connection ") : 151 write_c_string ((netp ? GETTEXT ("#<network connection ") :
152 GETTEXT ("#<process ")), printcharfun); 152 GETTEXT ("#<process ")), printcharfun);
153 print_internal (proc->name, printcharfun, 1); 153 print_internal (process->name, printcharfun, 1);
154 write_c_string ((netp ? " " : " pid "), printcharfun); 154 write_c_string ((netp ? " " : " pid "), printcharfun);
155 print_internal (proc->pid, printcharfun, 1); 155 print_internal (process->pid, printcharfun, 1);
156 write_c_string (" state:", printcharfun); 156 write_c_string (" state:", printcharfun);
157 print_internal (proc->status_symbol, printcharfun, 1); 157 print_internal (process->status_symbol, printcharfun, 1);
158 MAYBE_PROCMETH (print_process_data, (proc, printcharfun)); 158 MAYBE_PROCMETH (print_process_data, (process, printcharfun));
159 write_c_string (">", printcharfun); 159 write_c_string (">", printcharfun);
160 } 160 }
161 } 161 }
162 162
163 #ifdef HAVE_WINDOW_SYSTEM 163 #ifdef HAVE_WINDOW_SYSTEM
213 213
214 assert (usid != USID_ERROR && usid != USID_DONTHASH); 214 assert (usid != USID_ERROR && usid != USID_DONTHASH);
215 215
216 if (gethash ((const void*)usid, usid_to_process, &vval)) 216 if (gethash ((const void*)usid, usid_to_process, &vval))
217 { 217 {
218 Lisp_Object proc; 218 Lisp_Object process;
219 CVOID_TO_LISP (proc, vval); 219 CVOID_TO_LISP (process, vval);
220 return XPROCESS (proc); 220 return XPROCESS (process);
221 } 221 }
222 else 222 else
223 return 0; 223 return 0;
224 } 224 }
225 225
250 #endif 250 #endif
251 251
252 DEFUN ("processp", Fprocessp, 1, 1, 0, /* 252 DEFUN ("processp", Fprocessp, 1, 1, 0, /*
253 Return t if OBJECT is a process. 253 Return t if OBJECT is a process.
254 */ 254 */
255 (obj)) 255 (object))
256 { 256 {
257 return PROCESSP (obj) ? Qt : Qnil; 257 return PROCESSP (object) ? Qt : Qnil;
258 } 258 }
259 259
260 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* 260 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /*
261 Return t if OBJECT is a process that is alive. 261 Return t if OBJECT is a process that is alive.
262 */ 262 */
263 (obj)) 263 (object))
264 { 264 {
265 return PROCESSP (obj) && PROCESS_LIVE_P (XPROCESS (obj)) ? Qt : Qnil; 265 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object))
266 ? Qt : Qnil;
266 } 267 }
267 268
268 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* 269 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /*
269 Return a list of all processes. 270 Return a list of all processes.
270 */ 271 */
272 { 273 {
273 return Fcopy_sequence (Vprocess_list); 274 return Fcopy_sequence (Vprocess_list);
274 } 275 }
275 276
276 DEFUN ("get-process", Fget_process, 1, 1, 0, /* 277 DEFUN ("get-process", Fget_process, 1, 1, 0, /*
277 Return the process named NAME, or nil if there is none. 278 Return the process named PROCESS-NAME (a string), or nil if there is none.
278 */ 279 PROCESS-NAME may also be a process; if so, the value is that process.
279 (name)) 280 */
280 { 281 (process_name))
281 Lisp_Object tail; 282 {
282 283 if (PROCESSP (process_name))
283 if (PROCESSP (name)) 284 return process_name;
284 return name;
285 285
286 if (!gc_in_progress) 286 if (!gc_in_progress)
287 /* this only gets called during GC when emacs is going away as a result 287 /* this only gets called during GC when emacs is going away as a result
288 of a signal or crash. */ 288 of a signal or crash. */
289 CHECK_STRING (name); 289 CHECK_STRING (process_name);
290 290
291 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) 291 {
292 { 292 LIST_LOOP_2 (process, Vprocess_list)
293 Lisp_Object proc = XCAR (tail); 293 if (internal_equal (process_name, XPROCESS (process)->name, 0))
294 QUIT; 294 return process;
295 if (internal_equal (name, XPROCESS (proc)->name, 0)) 295 }
296 return XCAR (tail);
297 }
298 return Qnil; 296 return Qnil;
299 } 297 }
300 298
301 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* 299 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /*
302 Return the (or, a) process associated with BUFFER. 300 Return the (or, a) process associated with BUFFER.
303 BUFFER may be a buffer or the name of one. 301 BUFFER may be a buffer or the name of one.
304 */ 302 */
305 (name)) 303 (buffer))
306 { 304 {
307 Lisp_Object buf, tail, proc; 305 if (NILP (buffer)) return Qnil;
308 306 buffer = Fget_buffer (buffer);
309 if (NILP (name)) return Qnil; 307 if (NILP (buffer)) return Qnil;
310 buf = Fget_buffer (name); 308
311 if (NILP (buf)) return Qnil; 309 {
312 310 LIST_LOOP_2 (process, Vprocess_list)
313 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) 311 if (EQ (XPROCESS (process)->buffer, buffer))
314 { 312 return process;
315 /* jwz: do not quit here - it isn't necessary, as there is no way for 313 }
316 Vprocess_list to get circular or overwhelmingly long, and this
317 function is called from layout_mode_element under redisplay. */
318 /* QUIT; */
319 proc = XCAR (tail);
320 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
321 return proc;
322 }
323 return Qnil; 314 return Qnil;
324 } 315 }
325 316
326 /* This is how commands for the user decode process arguments. It 317 /* This is how commands for the user decode process arguments. It
327 accepts a process, a process name, a buffer, a buffer name, or nil. 318 accepts a process, a process name, a buffer, a buffer name, or nil.
329 current buffer. */ 320 current buffer. */
330 321
331 static Lisp_Object 322 static Lisp_Object
332 get_process (Lisp_Object name) 323 get_process (Lisp_Object name)
333 { 324 {
334 Lisp_Object proc, obj; 325 Lisp_Object buffer;
335 326
336 #ifdef I18N3 327 #ifdef I18N3
337 /* #### Look more closely into translating process names. */ 328 /* #### Look more closely into translating process names. */
338 #endif 329 #endif
339 330
340 /* This may be called during a GC from process_send_signal() from 331 /* This may be called during a GC from process_send_signal() from
341 kill_buffer_processes() if emacs decides to abort(). */ 332 kill_buffer_processes() if emacs decides to abort(). */
342 if (PROCESSP (name)) 333 if (PROCESSP (name))
343 return name; 334 return name;
344 335 else if (STRINGP (name))
345 if (STRINGP (name)) 336 {
346 { 337 Lisp_Object object = Fget_process (name);
347 obj = Fget_process (name); 338 if (PROCESSP (object))
348 if (NILP (obj)) 339 return object;
349 obj = Fget_buffer (name); 340
350 if (NILP (obj)) 341 buffer = Fget_buffer (name);
351 error ("Process %s does not exist", XSTRING_DATA (name)); 342 if (BUFFERP (buffer))
343 goto have_buffer_object;
344
345 error ("Process %s does not exist", XSTRING_DATA (name));
352 } 346 }
353 else if (NILP (name)) 347 else if (NILP (name))
354 obj = Fcurrent_buffer (); 348 {
355 else 349 buffer = Fcurrent_buffer ();
356 obj = name; 350 goto have_buffer_object;
357 351 }
358 /* Now obj should be either a buffer object or a process object. 352 else if (BUFFERP (name))
359 */ 353 {
360 if (BUFFERP (obj)) 354 Lisp_Object process;
361 { 355 buffer = name;
362 proc = Fget_buffer_process (obj); 356
363 if (NILP (proc)) 357 have_buffer_object:
364 error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); 358 process = Fget_buffer_process (buffer);
359 if (PROCESSP (process))
360 return process;
361
362 error ("Buffer %s has no process",
363 XSTRING_DATA (XBUFFER (buffer)->name));
365 } 364 }
366 else 365 else
367 { 366 return get_process (Fsignal (Qwrong_type_argument,
368 /* #### This was commented out. Although, simple 367 (list2 (build_string ("process or buffer or nil"),
369 (kill-process 7 "qqq") resulted in a fatal error. - kkm */ 368 name))));
370 CHECK_PROCESS (obj);
371 proc = obj;
372 }
373 return proc;
374 } 369 }
375 370
376 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* 371 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /*
377 Return the process id of PROCESS. 372 Return the process id of PROCESS.
378 This is the pid of the Unix process which PROCESS uses or talks to. 373 This is the pid of the Unix process which PROCESS uses or talks to.
379 For a network connection, this value is a cons of 374 For a network connection, this value is a cons of
380 (foreign-network-port . foreign-host-name). 375 (foreign-network-port . foreign-host-name).
381 */ 376 */
382 (proc)) 377 (process))
383 { 378 {
384 Lisp_Object pid; 379 Lisp_Object pid;
385 CHECK_PROCESS (proc); 380 CHECK_PROCESS (process);
386 381
387 pid = XPROCESS (proc)->pid; 382 pid = XPROCESS (process)->pid;
388 if (network_connection_p (proc)) 383 if (network_connection_p (process))
389 /* return Qnil; */ 384 /* return Qnil; */
390 return Fcons (Fcar (pid), Fcdr (pid)); 385 return Fcons (Fcar (pid), Fcdr (pid));
391 else 386 else
392 return pid; 387 return pid;
393 } 388 }
395 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* 390 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /*
396 Return the name of PROCESS, as a string. 391 Return the name of PROCESS, as a string.
397 This is the name of the program invoked in PROCESS, 392 This is the name of the program invoked in PROCESS,
398 possibly modified to make it unique among process names. 393 possibly modified to make it unique among process names.
399 */ 394 */
400 (proc)) 395 (process))
401 { 396 {
402 CHECK_PROCESS (proc); 397 CHECK_PROCESS (process);
403 return XPROCESS (proc)->name; 398 return XPROCESS (process)->name;
404 } 399 }
405 400
406 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* 401 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /*
407 Return the command that was executed to start PROCESS. 402 Return the command that was executed to start PROCESS.
408 This is a list of strings, the first string being the program executed 403 This is a list of strings, the first string being the program executed
409 and the rest of the strings being the arguments given to it. 404 and the rest of the strings being the arguments given to it.
410 */ 405 */
411 (proc)) 406 (process))
412 { 407 {
413 CHECK_PROCESS (proc); 408 CHECK_PROCESS (process);
414 return XPROCESS (proc)->command; 409 return XPROCESS (process)->command;
415 } 410 }
416 411
417 412
418 /************************************************************************/ 413 /************************************************************************/
419 /* creating a process */ 414 /* creating a process */
480 if (usid == USID_ERROR) 475 if (usid == USID_ERROR)
481 report_file_error ("Setting up communication with subprocess", Qnil); 476 report_file_error ("Setting up communication with subprocess", Qnil);
482 477
483 if (usid != USID_DONTHASH) 478 if (usid != USID_DONTHASH)
484 { 479 {
485 Lisp_Object proc = Qnil; 480 Lisp_Object process = Qnil;
486 XSETPROCESS (proc, p); 481 XSETPROCESS (process, p);
487 puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process); 482 puthash ((const void*)usid, LISP_TO_VOID (process), usid_to_process);
488 } 483 }
489 484
490 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); 485 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags));
491 486
492 #ifdef FILE_CODING 487 #ifdef FILE_CODING
520 if (PROCESS_LIVE_P (p)) 515 if (PROCESS_LIVE_P (p))
521 event_stream_select_process (p); 516 event_stream_select_process (p);
522 } 517 }
523 518
524 /* This function is the unwind_protect form for Fstart_process_internal. If 519 /* This function is the unwind_protect form for Fstart_process_internal. If
525 PROC doesn't have its pid set, then we know someone has signalled 520 PROCESS doesn't have its pid set, then we know someone has signalled
526 an error and the process wasn't started successfully, so we should 521 an error and the process wasn't started successfully, so we should
527 remove it from the process list. */ 522 remove it from the process list. */
528 static void remove_process (Lisp_Object proc); 523 static void remove_process (Lisp_Object process);
529 static Lisp_Object 524 static Lisp_Object
530 start_process_unwind (Lisp_Object proc) 525 start_process_unwind (Lisp_Object process)
531 { 526 {
532 /* Was PROC started successfully? */ 527 /* Was PROCESS started successfully? */
533 if (EQ (XPROCESS (proc)->pid, Qnil)) 528 if (EQ (XPROCESS (process)->pid, Qnil))
534 remove_process (proc); 529 remove_process (process);
535 return Qnil; 530 return Qnil;
536 } 531 }
537 532
538 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* 533 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
539 Start a program in a subprocess. Return the process object for it. 534 Start a program in a subprocess. Return the process object for it.
551 */ 546 */
552 (int nargs, Lisp_Object *args)) 547 (int nargs, Lisp_Object *args))
553 { 548 {
554 /* This function can call lisp */ 549 /* This function can call lisp */
555 /* !!#### This function has not been Mule-ized */ 550 /* !!#### This function has not been Mule-ized */
556 Lisp_Object buffer, name, program, proc, current_dir; 551 Lisp_Object buffer, name, program, process, current_dir;
557 Lisp_Object tem; 552 Lisp_Object tem;
558 int speccount = specpdl_depth (); 553 int speccount = specpdl_depth ();
559 struct gcpro gcpro1, gcpro2, gcpro3; 554 struct gcpro gcpro1, gcpro2, gcpro3;
560 555
561 name = args[0]; 556 name = args[0];
624 619
625 if (!NILP (Ffile_directory_p (program))) 620 if (!NILP (Ffile_directory_p (program)))
626 invalid_operation ("Specified program for new process is a directory", 621 invalid_operation ("Specified program for new process is a directory",
627 program); 622 program);
628 623
629 proc = make_process_internal (name); 624 process = make_process_internal (name);
630 625
631 XPROCESS (proc)->buffer = buffer; 626 XPROCESS (process)->buffer = buffer;
632 XPROCESS (proc)->command = Flist (nargs - 2, 627 XPROCESS (process)->command = Flist (nargs - 2,
633 args + 2); 628 args + 2);
634 629
635 /* Make the process marker point into the process buffer (if any). */ 630 /* Make the process marker point into the process buffer (if any). */
636 if (!NILP (buffer)) 631 if (!NILP (buffer))
637 Fset_marker (XPROCESS (proc)->mark, 632 Fset_marker (XPROCESS (process)->mark,
638 make_int (BUF_ZV (XBUFFER (buffer))), buffer); 633 make_int (BUF_ZV (XBUFFER (buffer))), buffer);
639 634
640 /* If an error occurs and we can't start the process, we want to 635 /* If an error occurs and we can't start the process, we want to
641 remove it from the process list. This means that each error 636 remove it from the process list. This means that each error
642 check in create_process doesn't need to call remove_process 637 check in create_process doesn't need to call remove_process
643 itself; it's all taken care of here. */ 638 itself; it's all taken care of here. */
644 record_unwind_protect (start_process_unwind, proc); 639 record_unwind_protect (start_process_unwind, process);
645 640
646 create_process (proc, args + 3, nargs - 3, program, current_dir); 641 create_process (process, args + 3, nargs - 3, program, current_dir);
647 642
648 UNGCPRO; 643 UNGCPRO;
649 return unbind_to (speccount, proc); 644 return unbind_to (speccount, process);
650 } 645 }
651 646
652 647
653 #ifdef HAVE_SOCKETS 648 #ifdef HAVE_SOCKETS
654 649
679 deactivate and close it via delete-process */ 674 deactivate and close it via delete-process */
680 675
681 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 676 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5,
682 0, /* 677 0, /*
683 Open a TCP connection for a service to a host. 678 Open a TCP connection for a service to a host.
684 Return a subprocess-object to represent the connection. 679 Return a process object to represent the connection.
685 Input and output work as for subprocesses; `delete-process' closes it. 680 Input and output work as for subprocesses; `delete-process' closes it.
686 681
687 NAME is name for process. It is modified if necessary to make it unique. 682 NAME is name for process. It is modified if necessary to make it unique.
688 BUFFER is the buffer (or buffer-name) to associate with the process. 683 BUFFER is the buffer (or buffer-name) to associate with the process.
689 Process output goes at end of that buffer, unless you specify 684 Process output goes at end of that buffer, unless you specify
690 an output stream or filter function to handle the output. 685 an output stream or filter function to handle the output.
691 BUFFER may also be nil, meaning that this process is not associated 686 BUFFER may also be nil, meaning that this process is not associated
692 with any buffer. 687 with any buffer.
693 Third arg is name of the host to connect to, or its IP address. 688 Third arg HOST (a string) is the name of the host to connect to,
694 Fourth arg SERVICE is name of the service desired, or an integer 689 or its IP address.
695 specifying a port number to connect to. 690 Fourth arg SERVICE is the name of the service desired (a string),
696 Fifth argument PROTOCOL is a network protocol. Currently 'tcp 691 or an integer specifying a port number to connect to.
692 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
697 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are 693 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
698 supported. When omitted, 'tcp is assumed. 694 supported. When omitted, 'tcp is assumed.
699 695
700 Output via `process-send-string' and input via buffer or filter (see 696 Output via `process-send-string' and input via buffer or filter (see
701 `set-process-filter') are stream-oriented. That means UDP datagrams are 697 `set-process-filter') are stream-oriented. That means UDP datagrams are
702 not guaranteed to be sent and received in discrete packets. (But small 698 not guaranteed to be sent and received in discrete packets. (But small
703 datagrams around 500 bytes that are not truncated by `process-send-string' 699 datagrams around 500 bytes that are not truncated by `process-send-string'
704 are usually fine.) Note further that UDP protocol does not guard against 700 are usually fine.) Note further that the UDP protocol does not guard
705 lost packets. 701 against lost packets.
706 */ 702 */
707 (name, buffer, host, service, protocol)) 703 (name, buffer, host, service, protocol))
708 { 704 {
709 /* !!#### This function has not been Mule-ized */ 705 /* !!#### This function has not been Mule-ized */
710 /* This function can GC */ 706 /* This function can GC */
711 Lisp_Object proc = Qnil; 707 Lisp_Object process = Qnil;
712 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; 708 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
713 void *inch, *outch; 709 void *inch, *outch;
714 710
715 GCPRO5 (name, buffer, host, service, protocol); 711 GCPRO5 (name, buffer, host, service, protocol);
716 CHECK_STRING (name); 712 CHECK_STRING (name);
725 PROCMETH (open_network_stream, (name, host, service, protocol, 721 PROCMETH (open_network_stream, (name, host, service, protocol,
726 &inch, &outch)); 722 &inch, &outch));
727 723
728 if (!NILP (buffer)) 724 if (!NILP (buffer))
729 buffer = Fget_buffer_create (buffer); 725 buffer = Fget_buffer_create (buffer);
730 proc = make_process_internal (name); 726 process = make_process_internal (name);
731 NGCPRO1 (proc); 727 NGCPRO1 (process);
732 728
733 XPROCESS (proc)->pid = Fcons (service, host); 729 XPROCESS (process)->pid = Fcons (service, host);
734 XPROCESS (proc)->buffer = buffer; 730 XPROCESS (process)->buffer = buffer;
735 init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 731 init_process_io_handles (XPROCESS (process), (void*)inch, (void*)outch,
736 STREAM_NETWORK_CONNECTION); 732 STREAM_NETWORK_CONNECTION);
737 733
738 event_stream_select_process (XPROCESS (proc)); 734 event_stream_select_process (XPROCESS (process));
739 735
740 UNGCPRO; 736 UNGCPRO;
741 NUNGCPRO; 737 NUNGCPRO;
742 return proc; 738 return process;
743 } 739 }
744 740
745 #ifdef HAVE_MULTICAST 741 #ifdef HAVE_MULTICAST
746 742
747 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* 743 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
748 Open a multicast connection on the specified dest/port/ttl. 744 Open a multicast connection on the specified dest/port/ttl.
749 Return a subprocess-object to represent the connection. 745 Return a process object to represent the connection.
750 Input and output work as for subprocesses; `delete-process' closes it. 746 Input and output work as for subprocesses; `delete-process' closes it.
751 747
752 NAME is name for process. It is modified if necessary to make it unique. 748 NAME is name for process. It is modified if necessary to make it unique.
753 BUFFER is the buffer (or buffer-name) to associate with the process. 749 BUFFER is the buffer (or buffer-name) to associate with the process.
754 Process output goes at end of that buffer, unless you specify 750 Process output goes at end of that buffer, unless you specify
762 */ 758 */
763 (name, buffer, dest, port, ttl)) 759 (name, buffer, dest, port, ttl))
764 { 760 {
765 /* !!#### This function has not been Mule-ized */ 761 /* !!#### This function has not been Mule-ized */
766 /* This function can GC */ 762 /* This function can GC */
767 Lisp_Object proc = Qnil; 763 Lisp_Object process = Qnil;
768 struct gcpro gcpro1; 764 struct gcpro gcpro1;
769 void *inch, *outch; 765 void *inch, *outch;
770 766
771 CHECK_STRING (name); 767 CHECK_STRING (name);
772 768
776 &inch, &outch)); 772 &inch, &outch));
777 773
778 if (!NILP (buffer)) 774 if (!NILP (buffer))
779 buffer = Fget_buffer_create (buffer); 775 buffer = Fget_buffer_create (buffer);
780 776
781 proc = make_process_internal (name); 777 process = make_process_internal (name);
782 GCPRO1 (proc); 778 GCPRO1 (process);
783 779
784 XPROCESS (proc)->pid = Fcons (port, dest); 780 XPROCESS (process)->pid = Fcons (port, dest);
785 XPROCESS (proc)->buffer = buffer; 781 XPROCESS (process)->buffer = buffer;
786 init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 782 init_process_io_handles (XPROCESS (process), (void*)inch, (void*)outch,
787 STREAM_NETWORK_CONNECTION); 783 STREAM_NETWORK_CONNECTION);
788 784
789 event_stream_select_process (XPROCESS (proc)); 785 event_stream_select_process (XPROCESS (process));
790 786
791 UNGCPRO; 787 UNGCPRO;
792 return proc; 788 return process;
793 } 789 }
794 #endif /* HAVE_MULTICAST */ 790 #endif /* HAVE_MULTICAST */
795 791
796 #endif /* HAVE_SOCKETS */ 792 #endif /* HAVE_SOCKETS */
797 793
803 799
804 800
805 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* 801 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
806 Tell PROCESS that it has logical window size HEIGHT and WIDTH. 802 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
807 */ 803 */
808 (proc, height, width)) 804 (process, height, width))
809 { 805 {
810 CHECK_PROCESS (proc); 806 CHECK_PROCESS (process);
811 CHECK_NATNUM (height); 807 CHECK_NATNUM (height);
812 CHECK_NATNUM (width); 808 CHECK_NATNUM (width);
813 return 809 return
814 MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (proc), XINT (height), XINT (width))) <= 0 810 MAYBE_INT_PROCMETH (set_window_size,
811 (XPROCESS (process), XINT (height), XINT (width))) <= 0
815 ? Qnil : Qt; 812 ? Qnil : Qt;
816 } 813 }
817 814
818 815
819 /************************************************************************/ 816 /************************************************************************/
827 This function reads at most 1024 bytes. 824 This function reads at most 1024 bytes.
828 If you want to read all available subprocess output, 825 If you want to read all available subprocess output,
829 you must call it repeatedly until it returns zero. */ 826 you must call it repeatedly until it returns zero. */
830 827
831 Charcount 828 Charcount
832 read_process_output (Lisp_Object proc) 829 read_process_output (Lisp_Object process)
833 { 830 {
834 /* This function can GC */ 831 /* This function can GC */
835 Bytecount nbytes, nchars; 832 Bytecount nbytes, nchars;
836 Bufbyte chars[1024]; 833 Bufbyte chars[1024];
837 Lisp_Object outstream; 834 Lisp_Object outstream;
838 Lisp_Process *p = XPROCESS (proc); 835 Lisp_Process *p = XPROCESS (process);
839 836
840 /* If there is a lot of output from the subprocess, the loop in 837 /* If there is a lot of output from the subprocess, the loop in
841 execute_internal_event() might call read_process_output() more 838 execute_internal_event() might call read_process_output() more
842 than once. If the filter that was executed from one of these 839 than once. If the filter that was executed from one of these
843 calls set the filter to t, we have to stop now. Return -1 rather 840 calls set the filter to t, we have to stop now. Return -1 rather
854 851
855 /* Some weird FSFmacs crap here with 852 /* Some weird FSFmacs crap here with
856 Vdeactivate_mark and current_buffer->keymap */ 853 Vdeactivate_mark and current_buffer->keymap */
857 running_asynch_code = 1; 854 running_asynch_code = 1;
858 filter_result = call2_trapping_errors ("Error in process filter", 855 filter_result = call2_trapping_errors ("Error in process filter",
859 p->filter, proc, Qnil); 856 p->filter, process, Qnil);
860 running_asynch_code = 0; 857 running_asynch_code = 0;
861 restore_match_data (); 858 restore_match_data ();
862 CHECK_INT (filter_result); 859 CHECK_INT (filter_result);
863 return XINT (filter_result); 860 return XINT (filter_result);
864 } 861 }
872 { 869 {
873 /* We used to bind inhibit-quit to t here, but 870 /* We used to bind inhibit-quit to t here, but
874 call2_trapping_errors() does that for us. */ 871 call2_trapping_errors() does that for us. */
875 running_asynch_code = 1; 872 running_asynch_code = 1;
876 call2_trapping_errors ("Error in process filter", 873 call2_trapping_errors ("Error in process filter",
877 outstream, proc, make_string (chars, nbytes)); 874 outstream, process, make_string (chars, nbytes));
878 running_asynch_code = 0; 875 running_asynch_code = 0;
879 restore_match_data (); 876 restore_match_data ();
880 return nchars; 877 return nchars;
881 } 878 }
882 879
889 Bufpos old_zv; 886 Bufpos old_zv;
890 int old_zmacs_region_stays = zmacs_region_stays; 887 int old_zmacs_region_stays = zmacs_region_stays;
891 struct gcpro gcpro1, gcpro2; 888 struct gcpro gcpro1, gcpro2;
892 struct buffer *buf = XBUFFER (p->buffer); 889 struct buffer *buf = XBUFFER (p->buffer);
893 890
894 GCPRO2 (proc, old_read_only); 891 GCPRO2 (process, old_read_only);
895 892
896 old_point = BUF_PT (buf); 893 old_point = BUF_PT (buf);
897 old_begv = BUF_BEGV (buf); 894 old_begv = BUF_BEGV (buf);
898 old_zv = BUF_ZV (buf); 895 old_zv = BUF_ZV (buf);
899 old_read_only = buf->read_only; 896 old_read_only = buf->read_only;
968 return nchars; 965 return nchars;
969 } 966 }
970 967
971 /* Sending data to subprocess */ 968 /* Sending data to subprocess */
972 969
973 /* send some data to process PROC. If NONRELOCATABLE is non-NULL, it 970 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it
974 specifies the address of the data. Otherwise, the data comes from the 971 specifies the address of the data. Otherwise, the data comes from the
975 object RELOCATABLE (either a string or a buffer). START and LEN 972 object RELOCATABLE (either a string or a buffer). START and LEN
976 specify the offset and length of the data to send. 973 specify the offset and length of the data to send.
977 974
978 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, 975 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
979 and in Bytecounts otherwise. */ 976 and in Bytecounts otherwise. */
980 977
981 void 978 void
982 send_process (Lisp_Object proc, 979 send_process (Lisp_Object process,
983 Lisp_Object relocatable, const Bufbyte *nonrelocatable, 980 Lisp_Object relocatable, const Bufbyte *nonrelocatable,
984 int start, int len) 981 int start, int len)
985 { 982 {
986 /* This function can GC */ 983 /* This function can GC */
987 struct gcpro gcpro1, gcpro2; 984 struct gcpro gcpro1, gcpro2;
988 Lisp_Object lstream = Qnil; 985 Lisp_Object lstream = Qnil;
989 986
990 GCPRO2 (proc, lstream); 987 GCPRO2 (process, lstream);
991 988
992 if (NILP (DATA_OUTSTREAM (XPROCESS (proc)))) 989 if (NILP (DATA_OUTSTREAM (XPROCESS (process))))
993 signal_simple_error ("Process not open for writing", proc); 990 signal_simple_error ("Process not open for writing", process);
994 991
995 if (nonrelocatable) 992 if (nonrelocatable)
996 lstream = 993 lstream =
997 make_fixed_buffer_input_stream (nonrelocatable + start, len); 994 make_fixed_buffer_input_stream (nonrelocatable + start, len);
998 else if (BUFFERP (relocatable)) 995 else if (BUFFERP (relocatable))
999 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), 996 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable),
1000 start, start + len, 0); 997 start, start + len, 0);
1001 else 998 else
1002 lstream = make_lisp_string_input_stream (relocatable, start, len); 999 lstream = make_lisp_string_input_stream (relocatable, start, len);
1003 1000
1004 PROCMETH (send_process, (proc, XLSTREAM (lstream))); 1001 PROCMETH (send_process, (process, XLSTREAM (lstream)));
1005 1002
1006 UNGCPRO; 1003 UNGCPRO;
1007 Lstream_delete (XLSTREAM (lstream)); 1004 Lstream_delete (XLSTREAM (lstream));
1008 } 1005 }
1009 1006
1010 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* 1007 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /*
1011 Return the name of the terminal PROCESS uses, or nil if none. 1008 Return the name of the terminal PROCESS uses, or nil if none.
1012 This is the terminal that the process itself reads and writes on, 1009 This is the terminal that the process itself reads and writes on,
1013 not the name of the pty that Emacs uses to talk with that terminal. 1010 not the name of the pty that Emacs uses to talk with that terminal.
1014 */ 1011 */
1015 (proc)) 1012 (process))
1016 { 1013 {
1017 CHECK_PROCESS (proc); 1014 CHECK_PROCESS (process);
1018 return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (proc))); 1015 return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (process)));
1019 } 1016 }
1020 1017
1021 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* 1018 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /*
1022 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). 1019 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1023 */ 1020 */
1024 (proc, buffer)) 1021 (process, buffer))
1025 { 1022 {
1026 CHECK_PROCESS (proc); 1023 CHECK_PROCESS (process);
1027 if (!NILP (buffer)) 1024 if (!NILP (buffer))
1028 CHECK_BUFFER (buffer); 1025 CHECK_BUFFER (buffer);
1029 XPROCESS (proc)->buffer = buffer; 1026 XPROCESS (process)->buffer = buffer;
1030 return buffer; 1027 return buffer;
1031 } 1028 }
1032 1029
1033 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* 1030 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /*
1034 Return the buffer PROCESS is associated with. 1031 Return the buffer PROCESS is associated with.
1035 Output from PROCESS is inserted in this buffer 1032 Output from PROCESS is inserted in this buffer
1036 unless PROCESS has a filter. 1033 unless PROCESS has a filter.
1037 */ 1034 */
1038 (proc)) 1035 (process))
1039 { 1036 {
1040 CHECK_PROCESS (proc); 1037 CHECK_PROCESS (process);
1041 return XPROCESS (proc)->buffer; 1038 return XPROCESS (process)->buffer;
1042 } 1039 }
1043 1040
1044 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* 1041 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /*
1045 Return the marker for the end of the last output from PROCESS. 1042 Return the marker for the end of the last output from PROCESS.
1046 */ 1043 */
1047 (proc)) 1044 (process))
1048 { 1045 {
1049 CHECK_PROCESS (proc); 1046 CHECK_PROCESS (process);
1050 return XPROCESS (proc)->mark; 1047 return XPROCESS (process)->mark;
1051 } 1048 }
1052 1049
1053 void 1050 void
1054 set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read) 1051 set_process_filter (Lisp_Object process, Lisp_Object filter, int filter_does_read)
1055 { 1052 {
1056 CHECK_PROCESS (proc); 1053 CHECK_PROCESS (process);
1057 if (PROCESS_LIVE_P (XPROCESS (proc))) { 1054 if (PROCESS_LIVE_P (XPROCESS (process))) {
1058 if (EQ (filter, Qt)) 1055 if (EQ (filter, Qt))
1059 event_stream_unselect_process (XPROCESS (proc)); 1056 event_stream_unselect_process (XPROCESS (process));
1060 else 1057 else
1061 event_stream_select_process (XPROCESS (proc)); 1058 event_stream_select_process (XPROCESS (process));
1062 } 1059 }
1063 1060
1064 XPROCESS (proc)->filter = filter; 1061 XPROCESS (process)->filter = filter;
1065 XPROCESS (proc)->filter_does_read = filter_does_read; 1062 XPROCESS (process)->filter_does_read = filter_does_read;
1066 } 1063 }
1067 1064
1068 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* 1065 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /*
1069 Give PROCESS the filter function FILTER; nil means no filter. 1066 Give PROCESS the filter function FILTER; nil means no filter.
1070 t means stop accepting output from the process. 1067 t means stop accepting output from the process.
1071 When a process has a filter, each time it does output 1068 When a process has a filter, each time it does output
1072 the entire string of output is passed to the filter. 1069 the entire string of output is passed to the filter.
1073 The filter gets two arguments: the process and the string of output. 1070 The filter gets two arguments: the process and the string of output.
1074 If the process has a filter, its buffer is not used for output. 1071 If the process has a filter, its buffer is not used for output.
1075 */ 1072 */
1076 (proc, filter)) 1073 (process, filter))
1077 { 1074 {
1078 set_process_filter (proc, filter, 0); 1075 set_process_filter (process, filter, 0);
1079 return filter; 1076 return filter;
1080 } 1077 }
1081 1078
1082 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* 1079 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /*
1083 Return the filter function of PROCESS; nil if none. 1080 Return the filter function of PROCESS; nil if none.
1084 See `set-process-filter' for more info on filter functions. 1081 See `set-process-filter' for more info on filter functions.
1085 */ 1082 */
1086 (proc)) 1083 (process))
1087 { 1084 {
1088 CHECK_PROCESS (proc); 1085 CHECK_PROCESS (process);
1089 return XPROCESS (proc)->filter; 1086 return XPROCESS (process)->filter;
1090 } 1087 }
1091 1088
1092 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /* 1089 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /*
1093 Send current contents of the region between START and END as input to PROCESS. 1090 Send current contents of the region between START and END as input to PROCESS.
1094 PROCESS may be a process name or an actual process. 1091 PROCESS may be a process or the name of a process, or a buffer or the
1092 name of a buffer, in which case the buffer's process is used. If it
1093 is nil, the current buffer's process is used.
1095 BUFFER specifies the buffer to look in; if nil, the current buffer is used. 1094 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1096 If the region is more than 500 or so characters long, 1095 If STRING is more than 100 or so characters long, it may be sent in
1097 it is sent in several bunches. This may happen even for shorter regions. 1096 several chunks. This may happen even for shorter strings. Output
1098 Output from processes can arrive in between bunches. 1097 from processes can arrive in between chunks.
1099 */ 1098 */
1100 (process, start, end, buffer)) 1099 (process, start, end, buffer))
1101 { 1100 {
1102 /* This function can GC */ 1101 /* This function can GC */
1103 Lisp_Object proc = get_process (process); 1102 Bufpos bstart, bend;
1104 Bufpos st, en;
1105 struct buffer *buf = decode_buffer (buffer, 0); 1103 struct buffer *buf = decode_buffer (buffer, 0);
1106 1104
1107 XSETBUFFER (buffer, buf); 1105 XSETBUFFER (buffer, buf);
1108 get_buffer_range_char (buf, start, end, &st, &en, 0); 1106 process = get_process (process);
1109 1107 get_buffer_range_char (buf, start, end, &bstart, &bend, 0);
1110 send_process (proc, buffer, 0, st, en - st); 1108
1109 send_process (process, buffer, 0, bstart, bend - bstart);
1111 return Qnil; 1110 return Qnil;
1112 } 1111 }
1113 1112
1114 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* 1113 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /*
1115 Send PROCESS the contents of STRING as input. 1114 Send PROCESS the contents of STRING as input.
1116 PROCESS may be a process name or an actual process. 1115 PROCESS may be a process or the name of a process, or a buffer or the
1117 Optional arguments FROM and TO specify part of STRING, see `substring'. 1116 name of a buffer, in which case the buffer's process is used. If it
1118 If STRING is more than 500 or so characters long, 1117 is nil, the current buffer's process is used.
1119 it is sent in several bunches. This may happen even for shorter strings. 1118 Optional arguments START and END specify part of STRING; see `substring'.
1120 Output from processes can arrive in between bunches. 1119 If STRING is more than 100 or so characters long, it may be sent in
1121 */ 1120 several chunks. This may happen even for shorter strings. Output
1122 (process, string, from, to)) 1121 from processes can arrive in between chunks.
1122 */
1123 (process, string, start, end))
1123 { 1124 {
1124 /* This function can GC */ 1125 /* This function can GC */
1125 Lisp_Object proc; 1126 Bytecount bstart, bend;
1126 Bytecount len; 1127
1127 Bytecount bfr, bto; 1128 process = get_process (process);
1128
1129 proc = get_process (process);
1130 CHECK_STRING (string); 1129 CHECK_STRING (string);
1131 get_string_range_byte (string, from, to, &bfr, &bto, 1130 get_string_range_byte (string, start, end, &bstart, &bend,
1132 GB_HISTORICAL_STRING_BEHAVIOR); 1131 GB_HISTORICAL_STRING_BEHAVIOR);
1133 len = bto - bfr; 1132
1134 1133 send_process (process, string, 0, bstart, bend - bstart);
1135 send_process (proc, string, 0, bfr, len);
1136 return Qnil; 1134 return Qnil;
1137 } 1135 }
1138 1136
1139 #ifdef FILE_CODING 1137 #ifdef FILE_CODING
1140 1138
1232 free_cons (d); 1230 free_cons (d);
1233 return Qnil; 1231 return Qnil;
1234 } 1232 }
1235 1233
1236 static void 1234 static void
1237 exec_sentinel (Lisp_Object proc, Lisp_Object reason) 1235 exec_sentinel (Lisp_Object process, Lisp_Object reason)
1238 { 1236 {
1239 /* This function can GC */ 1237 /* This function can GC */
1240 int speccount = specpdl_depth (); 1238 int speccount = specpdl_depth ();
1241 Lisp_Process *p = XPROCESS (proc); 1239 Lisp_Process *p = XPROCESS (process);
1242 Lisp_Object sentinel = p->sentinel; 1240 Lisp_Object sentinel = p->sentinel;
1243 1241
1244 if (NILP (sentinel)) 1242 if (NILP (sentinel))
1245 return; 1243 return;
1246 1244
1248 Vdeactivate_mark and current_buffer->keymap */ 1246 Vdeactivate_mark and current_buffer->keymap */
1249 1247
1250 /* Zilch the sentinel while it's running, to avoid recursive invocations; 1248 /* Zilch the sentinel while it's running, to avoid recursive invocations;
1251 assure that it gets restored no matter how the sentinel exits. */ 1249 assure that it gets restored no matter how the sentinel exits. */
1252 p->sentinel = Qnil; 1250 p->sentinel = Qnil;
1253 record_unwind_protect (exec_sentinel_unwind, noseeum_cons (proc, sentinel)); 1251 record_unwind_protect (exec_sentinel_unwind, noseeum_cons (process, sentinel));
1254 /* We used to bind inhibit-quit to t here, but call2_trapping_errors() 1252 /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1255 does that for us. */ 1253 does that for us. */
1256 running_asynch_code = 1; 1254 running_asynch_code = 1;
1257 call2_trapping_errors ("Error in process sentinel", sentinel, proc, reason); 1255 call2_trapping_errors ("Error in process sentinel", sentinel, process, reason);
1258 running_asynch_code = 0; 1256 running_asynch_code = 0;
1259 restore_match_data (); 1257 restore_match_data ();
1260 unbind_to (speccount, Qnil); 1258 unbind_to (speccount, Qnil);
1261 } 1259 }
1262 1260
1263 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* 1261 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /*
1264 Give PROCESS the sentinel SENTINEL; nil for none. 1262 Give PROCESS the sentinel SENTINEL; nil for none.
1265 The sentinel is called as a function when the process changes state. 1263 The sentinel is called as a function when the process changes state.
1266 It gets two arguments: the process, and a string describing the change. 1264 It gets two arguments: the process, and a string describing the change.
1267 */ 1265 */
1268 (proc, sentinel)) 1266 (process, sentinel))
1269 { 1267 {
1270 CHECK_PROCESS (proc); 1268 CHECK_PROCESS (process);
1271 XPROCESS (proc)->sentinel = sentinel; 1269 XPROCESS (process)->sentinel = sentinel;
1272 return sentinel; 1270 return sentinel;
1273 } 1271 }
1274 1272
1275 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* 1273 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /*
1276 Return the sentinel of PROCESS; nil if none. 1274 Return the sentinel of PROCESS; nil if none.
1277 See `set-process-sentinel' for more info on sentinels. 1275 See `set-process-sentinel' for more info on sentinels.
1278 */ 1276 */
1279 (proc)) 1277 (process))
1280 { 1278 {
1281 CHECK_PROCESS (proc); 1279 CHECK_PROCESS (process);
1282 return XPROCESS (proc)->sentinel; 1280 return XPROCESS (process)->sentinel;
1283 } 1281 }
1284 1282
1285 1283
1286 const char * 1284 const char *
1287 signal_name (int signum) 1285 signal_name (int signum)
1365 Lisp_Object tail = Qnil; 1363 Lisp_Object tail = Qnil;
1366 Lisp_Object symbol = Qnil; 1364 Lisp_Object symbol = Qnil;
1367 Lisp_Object msg = Qnil; 1365 Lisp_Object msg = Qnil;
1368 struct gcpro gcpro1, gcpro2, gcpro3; 1366 struct gcpro gcpro1, gcpro2, gcpro3;
1369 /* process_tick is volatile, so we have to remember it now. 1367 /* process_tick is volatile, so we have to remember it now.
1370 Otherwise, we get a race condition is SIGCHLD happens during 1368 Otherwise, we get a race condition if SIGCHLD happens during
1371 this function. 1369 this function.
1372 1370
1373 (Actually, this is not the case anymore. The code to 1371 (Actually, this is not the case anymore. The code to
1374 update the process structures has been moved out of the 1372 update the process structures has been moved out of the
1375 SIGCHLD handler. But for the moment I'm leaving this 1373 SIGCHLD handler. But for the moment I'm leaving this
1389 reference. */ 1387 reference. */
1390 GCPRO3 (tail, symbol, msg); 1388 GCPRO3 (tail, symbol, msg);
1391 1389
1392 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) 1390 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
1393 { 1391 {
1394 Lisp_Object proc = XCAR (tail); 1392 Lisp_Object process = XCAR (tail);
1395 Lisp_Process *p = XPROCESS (proc); 1393 Lisp_Process *p = XPROCESS (process);
1396 /* p->tick is also volatile. Same thing as above applies. */ 1394 /* p->tick is also volatile. Same thing as above applies. */
1397 int this_process_tick; 1395 int this_process_tick;
1398 1396
1399 /* #### extra check for terminated processes, in case a SIGCHLD 1397 /* #### extra check for terminated processes, in case a SIGCHLD
1400 got missed (this seems to happen sometimes, I'm not sure why). 1398 got missed (this seems to happen sometimes, I'm not sure why).
1407 { 1405 {
1408 p->update_tick = this_process_tick; 1406 p->update_tick = this_process_tick;
1409 1407
1410 /* If process is still active, read any output that remains. */ 1408 /* If process is still active, read any output that remains. */
1411 while (!EQ (p->filter, Qt) 1409 while (!EQ (p->filter, Qt)
1412 && read_process_output (proc) > 0) 1410 && read_process_output (process) > 0)
1413 ; 1411 ;
1414 1412
1415 /* Get the text to use for the message. */ 1413 /* Get the text to use for the message. */
1416 msg = status_message (p); 1414 msg = status_message (p);
1417 1415
1420 1418
1421 if (EQ (symbol, Qsignal) 1419 if (EQ (symbol, Qsignal)
1422 || EQ (symbol, Qexit)) 1420 || EQ (symbol, Qexit))
1423 { 1421 {
1424 if (delete_exited_processes) 1422 if (delete_exited_processes)
1425 remove_process (proc); 1423 remove_process (process);
1426 else 1424 else
1427 deactivate_process (proc); 1425 deactivate_process (process);
1428 } 1426 }
1429 1427
1430 /* Now output the message suitably. */ 1428 /* Now output the message suitably. */
1431 if (!NILP (p->sentinel)) 1429 if (!NILP (p->sentinel))
1432 exec_sentinel (proc, msg); 1430 exec_sentinel (process, msg);
1433 /* Don't bother with a message in the buffer 1431 /* Don't bother with a message in the buffer
1434 when a process becomes runnable. */ 1432 when a process becomes runnable. */
1435 else if (!EQ (symbol, Qrun) && !NILP (p->buffer)) 1433 else if (!EQ (symbol, Qrun) && !NILP (p->buffer))
1436 { 1434 {
1437 Lisp_Object old_read_only = Qnil; 1435 Lisp_Object old_read_only = Qnil;
1501 nil -- if arg is a process name and no such process exists. 1499 nil -- if arg is a process name and no such process exists.
1502 1500
1503 PROCESS may be a process, a buffer, the name of a process or buffer, or 1501 PROCESS may be a process, a buffer, the name of a process or buffer, or
1504 nil, indicating the current buffer's process. 1502 nil, indicating the current buffer's process.
1505 */ 1503 */
1506 (proc)) 1504 (process))
1507 { 1505 {
1508 Lisp_Object status_symbol; 1506 Lisp_Object status_symbol;
1509 1507
1510 if (STRINGP (proc)) 1508 if (STRINGP (process))
1511 proc = Fget_process (proc); 1509 process = Fget_process (process);
1512 else 1510 else
1513 proc = get_process (proc); 1511 process = get_process (process);
1514 1512
1515 if (NILP (proc)) 1513 if (NILP (process))
1516 return Qnil; 1514 return Qnil;
1517 1515
1518 status_symbol = XPROCESS (proc)->status_symbol; 1516 status_symbol = XPROCESS (process)->status_symbol;
1519 if (network_connection_p (proc)) 1517 if (network_connection_p (process))
1520 { 1518 {
1521 if (EQ (status_symbol, Qrun)) 1519 if (EQ (status_symbol, Qrun))
1522 status_symbol = Qopen; 1520 status_symbol = Qopen;
1523 else if (EQ (status_symbol, Qexit)) 1521 else if (EQ (status_symbol, Qexit))
1524 status_symbol = Qclosed; 1522 status_symbol = Qclosed;
1528 1526
1529 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* 1527 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /*
1530 Return the exit status of PROCESS or the signal number that killed it. 1528 Return the exit status of PROCESS or the signal number that killed it.
1531 If PROCESS has not yet exited or died, return 0. 1529 If PROCESS has not yet exited or died, return 0.
1532 */ 1530 */
1533 (proc)) 1531 (process))
1534 { 1532 {
1535 CHECK_PROCESS (proc); 1533 CHECK_PROCESS (process);
1536 return make_int (XPROCESS (proc)->exit_code); 1534 return make_int (XPROCESS (process)->exit_code);
1537 } 1535 }
1538 1536
1539 1537
1540 1538
1541 static int 1539 static int
1712 static void 1710 static void
1713 process_send_signal (Lisp_Object process, int signo, 1711 process_send_signal (Lisp_Object process, int signo,
1714 int current_group, int nomsg) 1712 int current_group, int nomsg)
1715 { 1713 {
1716 /* This function can GC */ 1714 /* This function can GC */
1717 Lisp_Object proc = get_process (process); 1715 process = get_process (process);
1718 1716
1719 if (network_connection_p (proc)) 1717 if (network_connection_p (process))
1720 error ("Network connection %s is not a subprocess", 1718 error ("Network connection %s is not a subprocess",
1721 XSTRING_DATA (XPROCESS(proc)->name)); 1719 XSTRING_DATA (XPROCESS(process)->name));
1722 CHECK_LIVE_PROCESS (proc); 1720 CHECK_LIVE_PROCESS (process);
1723 1721
1724 MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); 1722 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg));
1725 } 1723 }
1726 1724
1727 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /* 1725 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /*
1728 Send signal SIGNAL to process PROCESS. 1726 Send signal SIGNAL to process PROCESS.
1729 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. 1727 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1838 text to PROCESS after you call this function. 1836 text to PROCESS after you call this function.
1839 */ 1837 */
1840 (process)) 1838 (process))
1841 { 1839 {
1842 /* This function can GC */ 1840 /* This function can GC */
1843 Lisp_Object proc = get_process (process); 1841 process = get_process (process);
1844 1842
1845 /* Make sure the process is really alive. */ 1843 /* Make sure the process is really alive. */
1846 if (! EQ (XPROCESS (proc)->status_symbol, Qrun)) 1844 if (! EQ (XPROCESS (process)->status_symbol, Qrun))
1847 error ("Process %s not running", XSTRING_DATA (XPROCESS (proc)->name)); 1845 error ("Process %s not running", XSTRING_DATA (XPROCESS (process)->name));
1848 1846
1849 if (!MAYBE_INT_PROCMETH (process_send_eof, (proc))) 1847 if (!MAYBE_INT_PROCMETH (process_send_eof, (process)))
1850 { 1848 {
1851 if (!NILP (DATA_OUTSTREAM (XPROCESS (proc)))) 1849 if (!NILP (DATA_OUTSTREAM (XPROCESS (process))))
1852 { 1850 {
1853 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (proc)))); 1851 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process))));
1854 event_stream_delete_stream_pair (Qnil, XPROCESS (proc)->pipe_outstream); 1852 event_stream_delete_stream_pair (Qnil, XPROCESS (process)->pipe_outstream);
1855 XPROCESS (proc)->pipe_outstream = Qnil; 1853 XPROCESS (process)->pipe_outstream = Qnil;
1856 #ifdef FILE_CODING 1854 #ifdef FILE_CODING
1857 XPROCESS (proc)->coding_outstream = Qnil; 1855 XPROCESS (process)->coding_outstream = Qnil;
1858 #endif 1856 #endif
1859 } 1857 }
1860 } 1858 }
1861 1859
1862 return process; 1860 return process;
1866 /************************************************************************/ 1864 /************************************************************************/
1867 /* deleting a process */ 1865 /* deleting a process */
1868 /************************************************************************/ 1866 /************************************************************************/
1869 1867
1870 void 1868 void
1871 deactivate_process (Lisp_Object proc) 1869 deactivate_process (Lisp_Object process)
1872 { 1870 {
1873 Lisp_Process *p = XPROCESS (proc); 1871 Lisp_Process *p = XPROCESS (process);
1874 USID usid; 1872 USID usid;
1875 1873
1876 /* It's possible that we got as far in the process-creation 1874 /* It's possible that we got as far in the process-creation
1877 process as creating the descriptors but didn't get so 1875 process as creating the descriptors but didn't get so
1878 far as selecting the process for input. In this 1876 far as selecting the process for input. In this
1906 p->coding_outstream = Qnil; 1904 p->coding_outstream = Qnil;
1907 #endif 1905 #endif
1908 } 1906 }
1909 1907
1910 static void 1908 static void
1911 remove_process (Lisp_Object proc) 1909 remove_process (Lisp_Object process)
1912 { 1910 {
1913 Vprocess_list = delq_no_quit (proc, Vprocess_list); 1911 Vprocess_list = delq_no_quit (process, Vprocess_list);
1914 Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); 1912 Fset_marker (XPROCESS (process)->mark, Qnil, Qnil);
1915 1913
1916 deactivate_process (proc); 1914 deactivate_process (process);
1917 } 1915 }
1918 1916
1919 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* 1917 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /*
1920 Delete PROCESS: kill it and forget about it immediately. 1918 Delete PROCESS: kill it and forget about it immediately.
1921 PROCESS may be a process or the name of one, or a buffer name. 1919 PROCESS may be a process or the name of one, or a buffer name.
1922 */ 1920 */
1923 (proc)) 1921 (process))
1924 { 1922 {
1925 /* This function can GC */ 1923 /* This function can GC */
1926 Lisp_Process *p; 1924 Lisp_Process *p;
1927 proc = get_process (proc); 1925 process = get_process (process);
1928 p = XPROCESS (proc); 1926 p = XPROCESS (process);
1929 if (network_connection_p (proc)) 1927 if (network_connection_p (process))
1930 { 1928 {
1931 p->status_symbol = Qexit; 1929 p->status_symbol = Qexit;
1932 p->exit_code = 0; 1930 p->exit_code = 0;
1933 p->core_dumped = 0; 1931 p->core_dumped = 0;
1934 p->tick++; 1932 p->tick++;
1935 process_tick++; 1933 process_tick++;
1936 } 1934 }
1937 else if (PROCESS_LIVE_P (p)) 1935 else if (PROCESS_LIVE_P (p))
1938 { 1936 {
1939 Fkill_process (proc, Qnil); 1937 Fkill_process (process, Qnil);
1940 /* Do this now, since remove_process will make sigchld_handler do nothing. */ 1938 /* Do this now, since remove_process will make sigchld_handler do nothing. */
1941 p->status_symbol = Qsignal; 1939 p->status_symbol = Qsignal;
1942 p->exit_code = SIGKILL; 1940 p->exit_code = SIGKILL;
1943 p->core_dumped = 0; 1941 p->core_dumped = 0;
1944 p->tick++; 1942 p->tick++;
1945 process_tick++; 1943 process_tick++;
1946 status_notify (); 1944 status_notify ();
1947 } 1945 }
1948 remove_process (proc); 1946 remove_process (process);
1949 return Qnil; 1947 return Qnil;
1950 } 1948 }
1951 1949
1952 /* Kill all processes associated with `buffer'. 1950 /* Kill all processes associated with `buffer'.
1953 If `buffer' is nil, kill all processes */ 1951 If `buffer' is nil, kill all processes */
1954 1952
1955 void 1953 void
1956 kill_buffer_processes (Lisp_Object buffer) 1954 kill_buffer_processes (Lisp_Object buffer)
1957 { 1955 {
1958 Lisp_Object tail; 1956 LIST_LOOP_2 (process, Vprocess_list)
1959 1957 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer)))
1960 for (tail = Vprocess_list; CONSP (tail); 1958 {
1961 tail = XCDR (tail)) 1959 if (network_connection_p (process))
1962 { 1960 Fdelete_process (process);
1963 Lisp_Object proc = XCAR (tail); 1961 else if (PROCESS_LIVE_P (XPROCESS (process)))
1964 if (PROCESSP (proc) 1962 process_send_signal (process, SIGHUP, 0, 1);
1965 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) 1963 }
1966 {
1967 if (network_connection_p (proc))
1968 Fdelete_process (proc);
1969 else if (PROCESS_LIVE_P (XPROCESS (proc)))
1970 process_send_signal (proc, SIGHUP, 0, 1);
1971 }
1972 }
1973 } 1964 }
1974 1965
1975 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* 1966 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /*
1976 Say no query needed if PROCESS is running when Emacs is exited. 1967 Say no query needed if PROCESS is running when Emacs is exited.
1977 Optional second argument if non-nil says to require a query. 1968 Optional second argument if non-nil says to require a query.
1978 Value is t if a query was formerly required. 1969 Value is t if a query was formerly required.
1979 */ 1970 */
1980 (proc, require_query_p)) 1971 (process, require_query_p))
1981 { 1972 {
1982 int tem; 1973 int tem;
1983 1974
1984 CHECK_PROCESS (proc); 1975 CHECK_PROCESS (process);
1985 tem = XPROCESS (proc)->kill_without_query; 1976 tem = XPROCESS (process)->kill_without_query;
1986 XPROCESS (proc)->kill_without_query = NILP (require_query_p); 1977 XPROCESS (process)->kill_without_query = NILP (require_query_p);
1987 1978
1988 return tem ? Qnil : Qt; 1979 return tem ? Qnil : Qt;
1989 } 1980 }
1990 1981
1991 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* 1982 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /*
1992 Whether PROC will be killed without query if running when emacs is exited. 1983 Return t if PROCESS will be killed without query when emacs is exited.
1993 */ 1984 */
1994 (proc)) 1985 (process))
1995 { 1986 {
1996 CHECK_PROCESS (proc); 1987 CHECK_PROCESS (process);
1997 return XPROCESS (proc)->kill_without_query ? Qt : Qnil; 1988 return XPROCESS (process)->kill_without_query ? Qt : Qnil;
1998 } 1989 }
1999 1990
2000 1991
2001 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ 1992 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2002 void 1993 void