Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Allow callbacks to be retrieved without wrapper accumulation in the Racket binding |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
4b6ca5be46d9b3c89b45f45d14ce0f8e |
| User & Date: | murphy 2015-05-03 22:14:43 |
Context
|
2015-05-03
| ||
| 22:28 | Corrected native menu constructor call in Racket binding check-in: b9de6e58fe user: murphy tags: trunk | |
| 22:14 | Allow callbacks to be retrieved without wrapper accumulation in the Racket binding check-in: 4b6ca5be46 user: murphy tags: trunk | |
| 21:30 | Corrected Ihandle_ field alignment problem in Racket binding check-in: 215c766d56 user: murphy tags: trunk | |
Changes
Changes to racket/base.rkt.
279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 |
(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))])
(registry-set! handle
(cons
callback
(remove
(set/pointer! handle name callback)
(registry handle)
ptr-equal?)))))))
(define callback
(getter-with-setter
(get-ffi-obj
"IupGetCallback" libiup
(_fun [handle : _ihandle] [name : _iname/upcase]
-> [callback : _fpointer]
-> (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)
|
| > | < | > > | < > > > > | |
279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 |
(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* ([callback1 (function-ptr callback (callback-type 'callback-set! handle name))]
[callback0 (set/pointer! handle name callback1)])
(registry-set! handle
(cons
(cons callback1 callback)
((if callback0
(cute filter (λ (it) (not (ptr-equal? (car it) callback0))) <>)
identity)
(registry handle))))))))
(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))])))
callback-set!))
;; Layout functions
(define (make-constructor-procedure proc)
(make-keyword-procedure
(λ (keys key-args . pos-args)
|