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 279 (define callback-set! 280 280 (letrec ([set/pointer! 281 281 (get-ffi-obj 282 282 "IupSetCallback" libiup 283 283 (_fun [handle : _ihandle] [name : _iname/upcase] [callback : _fpointer] 284 284 -> [callback : _fpointer]))]) 285 285 (λ (handle name callback) 286 - (let ([callback (function-ptr callback (callback-type 'callback-set! handle name))]) 286 + (let* ([callback1 (function-ptr callback (callback-type 'callback-set! handle name))] 287 + [callback0 (set/pointer! handle name callback1)]) 287 288 (registry-set! handle 288 289 (cons 289 - callback 290 - (remove 291 - (set/pointer! handle name callback) 292 - (registry handle) 293 - ptr-equal?))))))) 290 + (cons callback1 callback) 291 + ((if callback0 292 + (cute filter (λ (it) (not (ptr-equal? (car it) callback0))) <>) 293 + identity) 294 + (registry handle)))))))) 294 295 295 296 (define callback 296 297 (getter-with-setter 297 298 (get-ffi-obj 298 299 "IupGetCallback" libiup 299 300 (_fun [handle : _ihandle] [name : _iname/upcase] 300 301 -> [callback : _fpointer] 301 - -> (cast callback _fpointer (callback-type 'callback handle name)))) 302 + -> (cond 303 + [(assoc callback (registry handle) ptr-equal?) 304 + => cdr] 305 + [else 306 + (cast callback _fpointer (callback-type 'callback handle name))]))) 302 307 callback-set!)) 303 308 304 309 ;; Layout functions 305 310 306 311 (define (make-constructor-procedure proc) 307 312 (make-keyword-procedure 308 313 (λ (keys key-args . pos-args)