Newsgroups: comp.lang.lisp,comp.lang.lisp.x
Path: cantaloupe.srv.cs.cmu.edu!bb3.andrew.cmu.edu!nntp.sei.cmu.edu!news.psc.edu!hudson.lm.com!godot.cc.duq.edu!news.duke.edu!agate!howland.reston.ans.net!ix.netcom.com!netcom.com!mayer
From: mayer@netcom.com (Niels P. Mayer)
Subject: Re: Anything like Expect (of Tcl implementation) in lisp?
Message-ID: <mayerDC5BnF.EwL@netcom.com>
Organization: NETCOM On-line Communication Services (408 261-4700 guest)
References: <WATTON_JD.95Jul20113942@watson.atc.alcoa.com>
Date: Sun, 23 Jul 1995 01:47:39 GMT
Lines: 634
Sender: mayer@netcom12.netcom.com
Xref: glinda.oz.cs.cmu.edu comp.lang.lisp:18403 comp.lang.lisp.x:1610

In article <WATTON_JD.95Jul20113942@watson.atc.alcoa.com>, watton_jd@atc.alcoa.com writes:
> I have already done the sort of things Expect does by writing commands
> to a bidirectional stream created in Allegro 4.2 using
> (excl:run-shell-command "csh -f" ...)
> and listening for the responses or the
> prompt to return. I am hopeful that more robust fuller functioned
> implementations are available but I couldn't find them in the Lisp
> repository.

This may not be useful for your particular application, but WINTERP 2.0
includes an asynchronous subprocess facility that allows you to "talk"
(bidirectionally) to a subprocess. Since the subprocesses response can be
asynchronous, a few simple callback handlers are provided to call a
function once per character, once per line, or once per complete
s-expression (useful for communicating with other processes that can output
their formatted data as s-expressions). Using the WINTERP process interface
allows you to call long-executing or interactive subprocesses without
causing the Lisp evaluator or GUI to "hang" waiting for the subprocess to
complete.

Note that I haven't implemented expect-like regular expression handlers at
this level, but it wouldn't be hard to build up such functionality from the
"once per line" callback.  Note that the "parsing" going on in the
once-per-sexpression or once-per-line callback handlers happen in WINTERP's
C-code, for efficiency.

See http://www.eit.com/software/winterp/winterp.html for more info on
WINTERP. WINTERP is the OSF/Motif Widget INTERPreter, a graphical,
application prototyping/delivery environment based on XLISP-PLUS.

For your viewing pleasure, here's some code examples using a simplified
interface that I built on top of the WINTERP's subprocess C-primitives
giving a higher level "asynchronsou unix subprocess object"
interface... Following that is the file definiting UNIX-SUBPROCESS-CLASS.


; -*-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         test-uxproc.lsp
; RCS:          $Header: /users/npm/src/widgit/examples/interactive/RCS/test-uxproc.lsp,v 1.4 1994/09/17 06:34:34 npm Exp npm $
; Description:  Tests of Unix-Subprocess-Class (see ../lib-utils/uxproc-cls.lsp)
; Author:       Niels P. Mayer
; Created:      Wed Aug 31 21:50:44 1994
; Modified:     Fri Sep 16 23:34:29 1994 (Niels Mayer) npm@indeed
; Language:     Lisp
; Package:      N/A
; Status:       X11r6 contrib release
;
; Copyright (C) 1994, Enterprise Integration Technologies Corp. and Niels Mayer.
; 
; Permission to use, copy, modify, distribute, and sell this software and its
; documentation for any purpose is hereby granted without fee, provided that
; the above copyright notice appear in all copies and that both that
; copyright notice and this permission notice appear in supporting
; documentation, and that the name of Enterprise Integration Technologies,
; Hewlett-Packard Company, or Niels Mayer not be used in advertising or
; publicity pertaining to distribution of the software without specific,
; written prior permission. Enterprise Integration Technologies, Hewlett-Packard
; Company, and Niels Mayer makes no representations about the suitability of
; this software for any purpose.  It is provided "as is" without express or
; implied warranty.
; 
; ENTERPRISE INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY AND NIELS MAYER
; DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ENTERPRISE
; INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY OR NIELS MAYER BE LIABLE
; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
; RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
; CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require "lib-utils/uxproc-cls")	;define UNIX-SUBPROCESS-CLASS

(defun show-gif (gif-path-str)
  (let (toplevel_w scrl_w gif_w)

    (setq toplevel_w
	  (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "gif-shell"
		))

    (setq scrl_w
	  (send XM_SCROLLED_WINDOW_WIDGET_CLASS :new :managed
		"sc" toplevel_w
		:XMN_SCROLLING_POLICY	:automatic
		))

    (setq gif_w
	  (send XM_LABEL_GADGET_CLASS :new :managed
		"gif" scrl_w
		:XMN_LABEL_TYPE	:pixmap
		:XMN_LABEL_PIXMAP	(gif_to_pixmap gif-path-str :verbose)
		))

    (send toplevel_w :realize)
    ))

(setq scrn-snap-proc
      (send UNIX-SUBPROCESS-CLASS :new :subshell
	    "( rm -f /tmp/foo.gif ; xwd -frame | xwdtopnm | ppmtogif > /tmp/foo.gif ) 2>&1"
	    ))

(send scrn-snap-proc :set-process-finished-callback
      #'(lambda (exit-status-dotted-pair)
	  (if (eq 0 (cdr exit-status-dotted-pair))
	      (show-gif "/tmp/foo.gif")
	    (error "screen-snapshot subprocess error" exit-status-dotted-pair))
	  ))

(send scrn-snap-proc :set-line-output-callback
      #'(lambda (FDINPUTCB_STRING)
	  (format T "line-out-cb: ~A\n" FDINPUTCB_STRING)
	  ))

(send scrn-snap-proc :start-process)    ;call this each time you want a 'snap'
(send scrn-snap-proc :exists_p)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq bc-proc
      (send UNIX-SUBPROCESS-CLASS :new :subproc
	    "bc"
	    ))

(send bc-proc :set-process-finished-callback
      #'(lambda (exit-status-dotted-pair)
	  (format T ":SET-PROCESS-FINISHED-CALLBACK=~A\n" exit-status-dotted-pair)
	  ))

(send bc-proc :set-line-output-callback
      #'(lambda (FDINPUTCB_STRING)
	  (format T "line-out-cb: ~A\n" FDINPUTCB_STRING)
	  ))

(send bc-proc :start-process)
(send bc-proc :exists_p)
(send bc-proc :format "2\n")
(send bc-proc :format ". ^ 2\n") ;evaluate multiple times to make "bc"
				 ;take a long time to return...
(send bc-proc :signal-kill "HUP")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq bogus-proc
      (send UNIX-SUBPROCESS-CLASS :new :subproc
	    "bogus-process"
	    ))

(send bogus-proc :set-process-finished-callback
      #'(lambda (exit-status-dotted-pair)
	  (format T ":SET-PROCESS-FINISHED-CALLBACK=~A\n" exit-status-dotted-pair)
	  ))

(send bogus-proc :set-line-output-callback
      #'(lambda (FDINPUTCB_STRING)
	  (format T "line-out-cb: ~A\n" FDINPUTCB_STRING)
	  ))

(send bogus-proc :start-process)                ;test error handling....
(send bogus-proc :exists_p)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq *xwpick-output-file* "/tmp/foo.gif")
(setq xwpick-proc
      (send UNIX-SUBPROCESS-CLASS :new :subproc
	    "xwpick" *xwpick-output-file*
	    ))

(send xwpick-proc :set-process-finished-callback
      #'(lambda (exit-status-dotted-pair)
	  (format T ":SET-PROCESS-FINISHED-CALLBACK=~A\n" exit-status-dotted-pair)
	  (if (eq 0 (cdr exit-status-dotted-pair))
	      (show-gif "/tmp/foo.gif")
	    (error "screen-snapshot subprocess error" exit-status-dotted-pair))
	  ))

(let ((xwpick-ready-str "press SPACE to pick image ...")
      (str ""))
  (send xwpick-proc :set-char-output-callback
	#'(lambda (FDINPUTCB_FILE)
	    (setq str
		  (concatenate 'string str (fscanf-string FDINPUTCB_FILE "%c")))
	    (if (eq 0 (search xwpick-ready-str str))
		(progn
		  (format T "~A\n" xwpick-ready-str)
		  (send xwpick-proc :set-line-output-callback
			#'(lambda (str) (format t "~A\n" str)))
		  ))
	    ))
  )


(send xwpick-proc :start-process)
(send xwpick-proc :exists_p)
(send xwpick-proc :signal-kill "HUP")

==============================================================================

; -*-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         uxproc-cls.lsp
; RCS:          $Header: /disk3/npm/src/widgit/examples/lib-utils/RCS/uxproc-cls.lsp,v 1.10 1994/09/04 08:09:33 npm Exp npm $
; Description:  Unix-Subprocess-Class and methods 
;		:SET-PROCESS-FINISHED-CALLBACK, :SET-LINE-OUTPUT-CALLBACK,
;		:SET-CHAR-OUTPUT-CALLBACK, :SET-SEXP-OUTPUT-CALLBACK
;		:START-PROCESS, :KILL-PROCESS, :SIGNAL-KILL, :EXISTS_P.
; Author:       Niels P. Mayer
; Created:      Wed Aug 31 21:50:44 1994
; Modified:     Sat May 27 00:01:29 1995 (Niels Mayer) npm@indeed
; Language:     Lisp
; Package:      N/A
; Status:       X11r6 contrib release
;
; Copyright (C) 1994, Enterprise Integration Technologies Corp. and Niels Mayer.
; 
; Permission to use, copy, modify, distribute, and sell this software and its
; documentation for any purpose is hereby granted without fee, provided that
; the above copyright notice appear in all copies and that both that
; copyright notice and this permission notice appear in supporting
; documentation, and that the name of Enterprise Integration Technologies,
; Hewlett-Packard Company, or Niels Mayer not be used in advertising or
; publicity pertaining to distribution of the software without specific,
; written prior permission. Enterprise Integration Technologies, Hewlett-Packard
; Company, and Niels Mayer makes no representations about the suitability of
; this software for any purpose.  It is provided "as is" without express or
; implied warranty.
; 
; ENTERPRISE INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY AND NIELS MAYER
; DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ENTERPRISE
; INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY OR NIELS MAYER BE LIABLE
; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
; RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
; CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require "lib-utils/initialize")	;define :set-pname, etc.
(require "lib-utils/unixstuf")		;define FILE:REMOVE-PATH

(in-package "WINTERP")
(export '(UNIX-SUBPROCESS-CLASS
	  ))

(setq UNIX-SUBPROCESS-CLASS
      (send Class :new
	    '(ivar_subproc_type		;ivars
	      ivar_args
	      ivar_end_cb
	      ivar_out_cb
	      ivar_outcb_kind
	      ivar_pty
	      ivar_pid
	      ivar_icb
	      ivar_ecb
	      )
	    '()				;cvars
					;this is not a subclass
	    ))
(send UNIX-SUBPROCESS-CLASS :set-pname "UNIX-SUBPROCESS-CLASS")

;; :ISNEW initialization method -- two variants:
;;
;; (send UNIX-SUBPROCESS-CLASS :new :subshell <command-str>)
;;	--> <ux-proc>
;; (send UNIX-SUBPROCESS-CLASS :new :subproc <proc-name> <arg-1> <arg-2> ...)
;;	--> <ux-proc>
;;
(send UNIX-SUBPROCESS-CLASS :answer :ISNEW
      '(k-subproc-type proc-str &rest args)
      '(
	(case k-subproc-type
	      (:subproc
	       (setq ivar_args       (cons proc-str
					   (cons (file:remove-path proc-str)
						 args)) ;setup args for exp_spawn
		     ivar_subproc_type	:subproc
		     ivar_end_cb	NIL
		     ivar_out_cb	NIL
		     ivar_outcb_kind	NIL
		     ivar_pid		NIL
		     ivar_pty		NIL
		     ivar_icb		NIL
		     ivar_ecb		NIL)
	       )
	      (:subshell
	       (if (not (and (stringp proc-str) (null args)))
		   (error "invalid arguments" (cons proc-str args)))
	       (setq ivar_args		(list proc-str) ;setup args for exp_popen
		     ivar_subproc_type	:subshell
		     ivar_end_cb	NIL
		     ivar_out_cb	NIL
		     ivar_outcb_kind	NIL
		     ivar_pid		NIL
		     ivar_pty		NIL
		     ivar_icb		NIL
		     ivar_ecb		NIL)
	       )
	      (t
	       (error "invalid subprocess type keyword, expected either :subproc or :subshell"
		      k_subproc_type)
	       ))
	))

;; :SET-PROCESS-FINISHED-CALLBACK -- set closure that gets
;; called when the process terminates.
;;
;; (send <ux-proc> :set-process-finished-callback
;;	 #'(lambda (exit-status-dotted-pair) ...))
;;   where exit-status-dotted-pair == (pid . exit-status) on success;
;;   and   exit-status-dotted-pair == (-1  . sys_errlist[errno]) on failure.
;;
(send UNIX-SUBPROCESS-CLASS :answer :SET-PROCESS-FINISHED-CALLBACK
      '(closure)
      '(
	(setq ivar_end_cb closure)

	;; if an old error callback was previously set, set a new one.
	;; but ... if this method called prior to :START-PROCESS, then
	;; don't. Note that :START-PROCESS calls :SET-PROCESS-FINISHED-CALLBACK
	;; once the process has been created.
	(if ivar_pty
	    (progn
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_ecb))
		       (input_active_p ivar_ecb))
		  (xt_remove_input ivar_ecb))

	      (if ivar_end_cb
		  ;; user wants his/her own code called in exception callback
		  (setq ivar_ecb
			(xt_add_input
			 ivar_pty :except
			 `(
;;;	             (format t "'~A' exception input callback called\n" (file:remove-path *audio-panel-proc*))

			   (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
				    (input_active_p ivar_icb))
			       (xt_remove_input ivar_icb))
			   (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_ecb))
				    (input_active_p ivar_ecb))
			       (xt_remove_input ivar_ecb))
			   (close ivar_pty)

			   (setq ivar_pid NIL
				 ivar_pty NIL
				 ivar_icb NIL
				 ivar_ecb NIL)

			   ;; Call the closure here...
			   (funcall ,ivar_end_cb
				    (exp_wait))
			   )))

		;; default exception callback
		(setq ivar_ecb
		      (xt_add_input
		       ivar_pty :except
		       '(
;;;	           (format t "'~A' exception input callback called\n" (file:remove-path *audio-panel-proc*))

			 (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
				  (input_active_p ivar_icb))
			     (xt_remove_input ivar_icb))
			 (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_ecb))
				  (input_active_p ivar_ecb))
			     (xt_remove_input ivar_ecb))
			 (close ivar_pty)
			 (setq ivar_pid NIL
			       ivar_pty NIL
			       ivar_icb NIL
			       ivar_ecb NIL)
			 (exp_wait)
			 )))
		))
	  )
	))

;;
;; :SET-LINE-OUTPUT-CALLBACK -- set closure that gets
;; called when the process terminates. 
;;
;; (send <ux-proc> :set-line-output-callback
;;	 #'(lambda (FDINPUTCB_STRING) ))
;;
(send UNIX-SUBPROCESS-CLASS :answer :SET-LINE-OUTPUT-CALLBACK
      '(closure)
      '(
	(setq ivar_outcb_kind :READ_LINE_TO_STRING)
	(setq ivar_out_cb closure)

	;; if an old input callback was previously set, set a new one.
	;; but ... if this method called prior to :START-PROCESS, then
	;; don't. Note that :START-PROCESS may call
	;; :SET-LINE-OUTPUT-CALLBACK once the process has been created.
	(if ivar_pty
	    (progn
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
		       (input_active_p ivar_icb))
		  (xt_remove_input ivar_icb))
	      (setq ivar_icb
		    (xt_add_input
		     ivar_pty ivar_outcb_kind
		     `(
		       (funcall ,ivar_out_cb FDINPUTCB_STRING)
		       )))
	      )
	  )
	))

;;
;; :SET-CHAR-OUTPUT-CALLBACK -- set closure that gets
;; called whenever there are characters available for
;; reading. Must use nonblocking reads, e.g. read-char.
;;
;; (send <ux-proc> :set-char-output-callback
;;	 #'(lambda (FDINPUTCB_FILE) ))
;;
(send UNIX-SUBPROCESS-CLASS :answer :SET-CHAR-OUTPUT-CALLBACK
      '(closure)
      '(
	(setq ivar_outcb_kind :READ)
	(setq ivar_out_cb closure)

	;; if an old input callback was previously set, set a new one.
	;; but ... if this method called prior to :START-PROCESS, then
	;; don't. Note that :START-PROCESS may call
	;; :SET-CHAR-OUTPUT-CALLBACK once the process has been created.
	(if ivar_pty
	    (progn
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
		       (input_active_p ivar_icb))
		  (xt_remove_input ivar_icb))
	      (setq ivar_icb
		    (xt_add_input
		     ivar_pty ivar_outcb_kind
		     `(
		       (funcall ,ivar_out_cb FDINPUTCB_FILE)
		       )))
	      )
	  )
	))

;; 
;; (send <ux-proc> :set-sexp-output-callback 
;;	 #'(lambda (FDINPUTCB_USTREAM) ))
;;
(send UNIX-SUBPROCESS-CLASS :answer :SET-SEXP-OUTPUT-CALLBACK
      '(closure)
      '(
	(setq ivar_outcb_kind :READ_SEXP_TO_USTREAM)
	(setq ivar_out_cb closure)

	;; if an old input callback was previously set, set a new one.
	;; but ... if this method called prior to :START-PROCESS, then
	;; don't. Note that :START-PROCESS may call
	;; :SET-SEXP-OUTPUT-CALLBACK once the process has been created.
	(if ivar_pty
	    (progn
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
		       (input_active_p ivar_icb))
		  (xt_remove_input ivar_icb))
	      (setq ivar_icb
		    (xt_add_input
		     ivar_pty ivar_outcb_kind
		     `(
		       (funcall ,ivar_out_cb FDINPUTCB_USTREAM)
		       )))
	      )
	  )
	))

;;
;; :CLEAR-OUTPUT-CALLBACK -- clear any previously set output callback
;;
;; (send <ux-proc> :clear-output-callback)
;;
(send UNIX-SUBPROCESS-CLASS :answer :CLEAR-OUTPUT-CALLBACK
      '()
      '(
	(if ivar_pty
	    (progn
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
		       (input_active_p ivar_icb))
		  (xt_remove_input ivar_icb))
	      ))
	))

;;
;; (send <ux-proc> :START-PROCESS)
;;
;; call this method to actually start the process. Should
;; probably :SET-PROCESS-FINISHED-CALLBACK and one of the
;; three output callback types via:
;;	:SET-SEXP-OUTPUT-CALLBACK
;;	:SET-CHAR-OUTPUT-CALLBACK or
;;	:SET-LINE-OUTPUT-CALLBACK
;;
(send UNIX-SUBPROCESS-CLASS :answer :START-PROCESS
      '()
      '(
	(case ivar_subproc_type
	      (:subproc
	       (setq ivar_pty
		     (apply #'exp_spawn ivar_args))
	       )
	      (:subshell
	       (setq ivar_pty
		     (apply #'exp_popen ivar_args))
	       ))
	(setq ivar_pid
	      (exp_get_pid)
	      )

	(if (eq 'CLOSURE (type-of ivar_out_cb))
	    (case ivar_outcb_kind
		  (:READ_LINE_TO_STRING
		   (send self :set-line-output-callback ivar_out_cb)
		   )
		  (:READ_SEXP_TO_USTREAM
		   (send self :set-sexp-output-callback ivar_out_cb)
		   )
		  (:READ
		   (send self :set-char-output-callback ivar_out_cb)
		   ))
	  ;; else if ivar_out_cb is not a closure (e.g. unititialized NIL),
	  ;; then don't bother setting an output callback.
	  )

	(if (eq 'CLOSURE (type-of ivar_end_cb))
	    (send self :set-process-finished-callback ivar_end_cb)	
	  (send self :set-process-finished-callback NIL) ;set default process finished callproc
	  )
	))

;;
;; (send <ux-proc> :KILL-PROCESS)
;; 
;; using this method is deprecated, since it will bypass call to callback
;; set by :SET-PROCESS-FINISHED-CALLBACK. This call can be put
;; inside a widget's :XMN_DESTROY_CALLBACK, so as to ensure
;; destruction of process is "synchronous". For example, it may be
;; inappropriate to call the callback set by
;; :SET-PROCESS-FINISHED-CALLBACK after the widgetry associated with
;; the process no longer exists.
;;
(send UNIX-SUBPROCESS-CLASS :answer :KILL-PROCESS
      '()
      '(
	(if ivar_pid
	    (progn
	      (exp_kill "KILL" ivar_pid)
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_icb))
		       (input_active_p ivar_icb))
		  (xt_remove_input ivar_icb))
	      (if (and (eq 'FDINPUTCB_OBJ (type-of ivar_ecb))
		       (input_active_p ivar_ecb))
		  (xt_remove_input ivar_ecb))
	      (close ivar_pty)
	      (setq ivar_pid	NIL
		    ivar_icb	NIL
		    ivar_ecb	NIL
		    ivar_pty	NIL)
	      (exp_wait)
	      T
	      )
	  NIL
	  )
	))

;;
;; (send <ux-proc> :SIGNAL-KILL <kill-sig>)
;;
;; Send the subprocess a kill signal. Note that the process is known to
;; have terminated only when the callback set in :SET-PROCESS-FINISHED-CALLBACK
;; is called...
;;
(send UNIX-SUBPROCESS-CLASS :answer :SIGNAL-KILL
      '(kill-sig)
      '(
	(if ivar_pid
	    (exp_kill kill-sig ivar_pid)
	  (error "can't signal process -- process doesn't exist"
		 ivar_args
		 )
	  )
	))

;;
;; (send <ux-proc> :EXISTS_P)
;;
;; Boolean -- check if the subprocess associated with the object is running.
;;
(send UNIX-SUBPROCESS-CLASS :answer :EXISTS_P
      '()
      '(
	(streamp ivar_pty)
	))

;;
;; (send <ux-proc> :FORMAT <format-string> <format-arg-1> ... <format-arg-n>)
;;
;; Use the 'format' command to send data to the subprocess. See
;; 'format' for a descruption of the formatting commands available
;; for <format-str>.
;;
(send UNIX-SUBPROCESS-CLASS :answer :FORMAT
      '(format-str &rest args)
      '(
	(if (streamp ivar_pty)
	    (apply #'format ivar_pty format-str args)
	  (error "can't send to process -- process doesn't exist"
		 ivar_args))
	))

;;
;; (send <ux-proc> :GET-PID)
;;	--> returns process ID as a FIXNUM, or NIL if
;;	    process doesn't exist.
;;
(send UNIX-SUBPROCESS-CLASS :answer :GET-PID
      '()
      '(ivar_pid))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide "lib-utils/uxproc-cls")


=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
= Niels Mayer ..... mayer@eit.com .... http://www.eit.com/people/mayer.html =
=  Multimedia Engineering Collaboration Environment (MM authoring for WWW)  =
=  Enterprise Integration Technologies, 800 El Camino Real, Menlo Park, CA  =
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
