Tk mit newLISP unter Betriebssystem Unix 

#!/usr/bin/newlisp

(context 'Tk)

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

(define (string1 el)
  (if (symbol? el)
      (term el)
      (string el)))

(define (eval1 el)
  (if (and (symbol? el)
           (member ((term el) 0) "-.<"))
      (term el)
      (string? el)
      (replace [text]([\\ {}"\[\]])[/text] (copy el) (append {\} $1) 0)
      (eval el)))

(define (argsToString argl)
  (let ((arg0 (argl 0))
        (arg1 (if (list? (argl 1))
                  (eval (argl 1))
                  (argl 1)))
        (restl (map eval1 (2 argl))))
       (join (map string1 (append (list arg0 arg1) restl)) " ")))

(define-macro (Tk:Tk)
  (if (string? ((args) 0))
      (wish ((args) 0))
      (wish (argsToString (args)))))

(define (define-widget (WINDOW "."))
  (context MAIN)
  (constant (sym WINDOW)
    (expand
      (lambda-macro ()
        (Tk:wish (Tk:argsToString (cons WINDOW (args)))))
      'WINDOW)))

;; =====

(define-widget)

(define (stringMap searchList word)
  (if (null? searchList)
      word
      (letn ((searchStr (searchList 0))
             (replaceStr (searchList 1))
             (foundIdx (find searchStr word)))
            (if foundIdx
              (letn ((front (0 foundIdx word))
                     (backIdx (+ foundIdx (length searchStr)))
                     (back (backIdx word)))
                    (append (stringMap (2 searchList) front)
                            replaceStr
                            (stringMap searchList back)))
              (stringMap (2 searchList) word)))))

(set-locale "C")

(define (wish str)
  (timer 'listen 0)
  (write-line myout
    (append
      [text] if {[catch {puts [string map  [list \n \\n \\ \\\\] [ [/text]
      (stringMap '("\n" {\n}) str)
      [text] ]]}]} {
      tk_messageBox -icon warning -message $errorInfo
      puts [string map [list \n \\n] $errorInfo]
      } [/text]))
  (let ((result (stringMap '({\\} {\} {\n} "\n") (read-line myin))))
    (if (regex {^\.[a-zA-Z0-9]*(?:\.[a-zA-Z0-9]+)*$} result)
        (define-widget result))
    (timer 'listen 0.1)
    result))

(define (listen)
  (while (not (null? (peek myin)))
         (eval-string (read-line myin) 'MAIN))
  (timer 'listen 0.1))

(set-locale "")

(wish {bind [winfo class .] <Destroy> {puts (exit)}})

(listen)

;; =====

(context MAIN)
(global '.)

22.3.2023