Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
listener from hell with chanl
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload '("iup" "chanl" "bordeaux-threads")))
(defpackage #:iup-examples.listener
(:use #:common-lisp)
(:export #:listener))
(in-package #:iup-examples.listener)
(defvar *idle-action-lock* (bt:make-lock "idle-action"))
(defun make-listener (channel-in multi-line)
(bt:make-thread
(lambda ()
(loop :for d := (chanl:recv channel-in)
:for r := (write-to-string (eval (read-from-string d)))
:do (bt:with-lock-held (*idle-action-lock*)
(setf (iup:idle-action)
(lambda ()
(setf (iup:attribute multi-line :append) r)
;; FIXME how to make this wait for completion?? ^^^ nother lock prob..
iup:+ignore+)))))))
(defun listener ()
(iup:with-iup ()
(let* ((output (iup:multi-line :expand :yes))
(input (iup:text :expand :horizontal))
(interrupt (iup:button :title "Interrupt"))
(hbox (iup:hbox (list input interrupt)))
(vbox (iup:vbox (list output hbox)))
(dialog (iup:dialog vbox
:title "Listener from Hell"
:size "HALFxHALF")))
(iup:show dialog)
(let* ((channel (make-instance 'chanl:unbounded-channel))
(listener (make-listener channel output)))
(setf (iup:callback input :k_any)
(lambda (handle c)
(when (= c 13)
(let ((string (iup:attribute handle :value)))
(setf (iup:attribute handle :value) "")
(chanl:send channel string)))
iup:+default+))
(setf (iup:callback dialog :destroy_cb)
(bt:destroy-thread listener)))
(iup:main-loop))))
#-sbcl (listener)
#+sbcl
(sb-int:with-float-traps-masked
(:divide-by-zero :invalid)
(listener))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment