; Start a sub process that runs "wish"
; Use as:
; (tk ....) to deliver tk (wish) text
; (tk:hanshake ....) does the same
; (tk:stop) to stop the sub process
(context 'tk)

(map set '(myin tcout) (pipe))
(map set '(tcin myout) (pipe))

(setf TAG "newLISP: " TAG* (length TAG))

(set 'SUB (process "/usr/bin/wish" tcin tcout))

(define (tk:tk) (apply handshake (args)))

(define (read-tcl (DISCARD nil))
  (let ((BUFFER ""))
    (when (read myin BUFFER 10000)
      (unless DISCARD (println BUFFER)))))

; function to pass commands to Tcl/Tk 
(define (handshake)
  (let (str "")
    (write-line myout
                (format "if { [catch { puts [%s] }] } { %s }"
                        (apply string (args))
                        "tk_messageBox -message $errorInfo; exit" ))
    (read-tcl true)
    str))

(define (load-tcl FILE)
  (write myout (read-file FILE)))

(define (read-loop)
  (let ((FD nil) (BUFFER))
    (while (and (setf FD (net-select (list 0 myin) "r" -1)) (member myin FD))
      (when (> (read myin BUFFER 100000))
        (if (starts-with BUFFER TAG)
            (eval-string (TAG* BUFFER) MAIN)
          (println BUFFER)
          )))))

(context MAIN)

;; exit when main window is closed
;(tk "bind . <Destroy> {puts {newLISP: (exit)}}") 

"runtk.lsp"