Using Tcl/Tk with CLISP (was Re: Multi-return value functions and with-input-stream-do)

[dudeyp@research.CS.ORST.EDU (Peter Dudey Drake)]

I've been using a cheap hack wherein I launch Lisp from a wish
process, set up a read-eval-print loop there, and have Tcl read and
write to the Lisp process.  (This requires two small files, below.)
Your method sounds more elegant, but I don't really know anything
about pipes.  Tell us if you figure it out...

To use my stuff, start wish and do like this:

% source join.tcl
% start_lisp
Lisp process started
Loading join.lisp
Starting event loop
Lisp ready
% lisp_eval "(+ 2 2)"
4
% lisp_eval "(defun foo (x) (+ x x))"
FOO
% lisp_eval "(foo 3)"
6
% lisp_eval "(quit)"
% exit

The tcl_to_lisp and lisp_to_tcl procs are quite nice, but be warned
that you may sometimes have to add or remove a set of braces to get
the right list in and out of tcl.

Enjoy!

+-     PETER DUDEY DRAKE      279-D SE Lilly Ave.,  Corvallis, OR  97333     -+
|       MS student in Artificial Intelligence, Oregon State University        |
|                   Where I come from, we're ALL like this.                   |
+-  drakep@research.cs.orst.edu        (finger dudeyp@research.cs.orst.edu)  -+



Here's my Tcl file, join.tcl.  It assumes that you have a symbolic
link called "lisp" in the current directory that runs your Lisp.

proc start_lisp {} { 
  global Lisp_pipe
  set Lisp_pipe [open {|lisp} r+ ]
  after 2000
  puts "Lisp process started"
  write_lisp "(load \"join.lisp\")"
  puts "Loading join.lisp"
  read_till_prompt
  write_lisp "(talk-to-tcl)"
  puts "Starting event loop"
  read_till_prompt
  puts "Lisp ready"
}

proc write_lisp {string} {
  global Lisp_pipe

  puts $Lisp_pipe $string
  flush $Lisp_pipe
}

proc read_lisp {} {
  global Lisp_pipe

  return [gets $Lisp_pipe]
}

proc read_till_prompt {} {
  global Lisp_pipe
  set text {}
  while {[string compare [string range $text 0 4] READY]} {
	gets $Lisp_pipe text
#       Uncomment the next line for debugging
#	puts $text
		}
}

proc lisp_eval {string} {
#    puts "Evaluating $string"
    write_lisp $string
    if {$string != "(quit)"} {
	set result [read_lisp]
#	puts $result
	read_till_prompt
	return $result
    }
}

proc tcl_to_lisp {list} {
    ## Replaces braces with parentheses
    regsub -all "\{" [list $list] "\(" result
    regsub -all "\}" $result "\)" result
    return $result
}

proc lisp_to_tcl {list} {
    ## Replaces parentheses with braces
    regsub -all {\(} $list "\{" result
    regsub -all {\)} $result "\}" result
    return [lindex $result 0]
}


And here's join.lisp:

(format t "~%READY~%")
(force-output t)

(defun talk-to-tcl ()
 (format t "~%READY~%")
 (force-output t)
  (do ((text (read) (read)))
      (())
      (format t "~a~%READY~%" (write-to-string (eval text)))))