tk.lsp 

#!/usr/bin/newlisp

;; file: tk.lsp
;; provides low-level access to Tcl/Tk

(map set '(myin tcout) (pipe))
(map set '(tcin myout) (pipe))
(process "/usr/bin/wish" tcin tcout)

(define (tk)
  (write-line
   myout
   (append
    "if {[catch {puts ["
    (join
     (map
      (lambda (e) (if (symbol? e) (term e) (string e)))
      (args))
     " ")
    "]}]}"
    [text] {
    tk_messageBox -message $errorInfo
    } [/text]))
  (read-line myin))

;; usage example next line:
(tk " bind . <Destroy> {puts {(exit)}} ")

(map constant '(myin tcout tcin myout tk))

(global 'tk) 

(map load (2 (main-args)))

(set 'event-loop-running nil)

(define (read-lines chan)
  (local
   (buf)
   (read chan buf (peek chan))
   (string buf)))

;; process incoming newLISP requests
(define (event-loop (bool true))
  (cond
   ((null? bool) (set 'event-loop-running nil))
   ((null? event-loop-running)
    (set 'event-loop-running true)
    (while event-loop-running
      (local
       (result)
       (if (catch (eval-string (read-lines myin)) 'result)
	   result
	 (tk
	  (append
	   "tk_messageBox -icon error -title Error"
	   " -message {" (string result) "}"))))))))

(event-loop)

;; eof

6.1.2023