1 ; Start a sub process that runs "wish"
3 ; (tk ....) to deliver tk (wish) text
4 ; (tk:hanshake ....) does the same
5 ; (tk:stop) to stop the sub process
8 (map set '(myin tcout) (pipe))
9 (map set '(tcin myout) (pipe))
11 (setf TAG "newLISP: " TAG* (length TAG))
13 (set 'SUB (process "/usr/bin/wish" tcin tcout))
15 (define (tk:tk) (apply handshake (args)))
17 (define (read-tcl (DISCARD nil))
19 (when (read myin BUFFER 10000)
20 (unless DISCARD (println BUFFER)))))
22 ; function to pass commands to Tcl/Tk
26 (format "if { [catch { puts [%s] }] } { %s }"
28 "tk_messageBox -message $errorInfo; exit" ))
32 (define (load-tcl FILE)
33 (write myout (read-file FILE)))
36 (let ((FD nil) (BUFFER))
37 (while (and (setf FD (net-select (list 0 myin) "r" -1)) (member myin FD))
38 (when (> (read myin BUFFER 100000))
39 (if (starts-with BUFFER TAG)
40 (eval-string (TAG* BUFFER) MAIN)
46 ;; exit when main window is closed
47 ;(tk "bind . <Destroy> {puts {newLISP: (exit)}}")