IUP

Check-in [215c766d56]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Corrected Ihandle_ field alignment problem in Racket binding
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 215c766d56195bec17b6ff218dcdf2d131a2f75d
User & Date: murphy 2015-05-03 21:30:26
Context
2015-05-03
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
20:06
Avoid useless shadowing of identifiers in recent file menu code check-in: 2e2a7ad35a user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to racket/base.rkt.

199
200
201
202
203
204
205


206
207
208
209
210
211
212
...
220
221
222
223
224
225
226
227



228
229
230
231
232
233
234
   (_fun -> _void)))

(define main-loop-flush
  (get-ffi-obj
   "IupFlush" libiup
   (_fun -> _void)))



(define callback-type
  (letrec ([type-cache
            (make-hash)]
           [callback-signature
            (get-ffi-obj
             "iupClassCallbackGetFormat" libiup
             (_fun [class : _pointer] [name : _iname/upcase] -> [format : _string/utf-8]))]
................................................................................
                [(#\s) _string/utf-8]
                [(#\v) _pointer]
                [(#\h) _ihandle/null]
                [else  (error location "bad callback ~s type ~e" (if param? "parameter" "return") char)]))])
    (λ (location handle name)
      (unless (ihandle? handle)
        (raise-type-error location "non-null `ihandle' pointer" handle))
      (let ([signature (callback-signature (ptr-ref (ptr-add handle 4) _pointer) name)])



        (or
         (hash-ref type-cache signature #f)
         (match signature
           [(regexp #rx"^([^=]*)(=.)?$" (list _ params return))
            (let* ([return
                    (cond [return => (cut string-ref <> 1)] [else #\i])]
                   [type







>
>







 







|
>
>
>







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
   (_fun -> _void)))

(define main-loop-flush
  (get-ffi-obj
   "IupFlush" libiup
   (_fun -> _void)))

(define-cstruct _ihandle* ([sig (_array _byte 4)] [iclass _pointer]))

(define callback-type
  (letrec ([type-cache
            (make-hash)]
           [callback-signature
            (get-ffi-obj
             "iupClassCallbackGetFormat" libiup
             (_fun [class : _pointer] [name : _iname/upcase] -> [format : _string/utf-8]))]
................................................................................
                [(#\s) _string/utf-8]
                [(#\v) _pointer]
                [(#\h) _ihandle/null]
                [else  (error location "bad callback ~s type ~e" (if param? "parameter" "return") char)]))])
    (λ (location handle name)
      (unless (ihandle? handle)
        (raise-type-error location "non-null `ihandle' pointer" handle))
      (let ([signature
             (or
              (callback-signature (ihandle*-iclass (cast handle _ihandle _ihandle*-pointer)) name)
              "")])
        (or
         (hash-ref type-cache signature #f)
         (match signature
           [(regexp #rx"^([^=]*)(=.)?$" (list _ params return))
            (let* ([return
                    (cond [return => (cut string-ref <> 1)] [else #\i])]
                   [type