IUP

(define callback-set!
  (letrec ([set/pointer!
            (get-ffi-obj
             "IupSetCallback" libiup
             (_fun [handle : _ihandle] [name : _iname/upcase] [callback : _fpointer]
                   -> [callback : _fpointer]))])
    (λ (handle name callback)
      (let ([callback (function-ptr callback (callback-type 'callback-set! handle name))])
      (let* ([callback1 (function-ptr callback (callback-type 'callback-set! handle name))]
             [callback0 (set/pointer! handle name callback1)])
        (registry-set! handle
          (cons
           callback
           (cons callback1 callback)
           (remove
            (set/pointer! handle name callback)
            (registry handle)
           ((if callback0
                (cute filter (λ (it) (not (ptr-equal? (car it) callback0))) <>)
                identity)
            (registry handle))))))))
            ptr-equal?)))))))

(define callback
  (getter-with-setter
   (get-ffi-obj
    "IupGetCallback" libiup
    (_fun [handle : _ihandle] [name : _iname/upcase]
          -> [callback : _fpointer]
          -> (cond
               [(assoc callback (registry handle) ptr-equal?)
                => cdr]
               [else
          -> (cast callback _fpointer (callback-type 'callback handle name))))
                (cast callback _fpointer (callback-type 'callback handle name))])))
   callback-set!))

;; Layout functions

(define (make-constructor-procedure proc)
  (make-keyword-procedure
   (λ (keys key-args . pos-args)