Changeset 20671 in project


Ignore:
Timestamp:
10/06/10 18:14:02 (9 years ago)
Author:
Thomas Chust
Message:

[iup] CHICKEN 4.6.2 migration: Use of irregex and pointer-vectors

Location:
release/4/iup/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/iup/trunk/iup-base.scm

    r20583 r20671  
    11(require-library
    2         lolevel data-structures extras srfi-1 srfi-13 srfi-42 regex posix)
     2        lolevel data-structures extras srfi-1 srfi-13 srfi-42 irregex posix)
    33
    44(module iup-base
    5         (ihandle->pointer pointer->ihandle ihandle-list->blob ihandle?
     5        (ihandle->pointer pointer->ihandle ihandle-list->pointer-vector ihandle?
    66         istatus->integer integer->istatus
    77         iname->string string->iname
     
    3030        (import
    3131                scheme chicken foreign
    32                 lolevel data-structures extras srfi-1 srfi-13 srfi-42 regex
     32                lolevel data-structures extras srfi-1 srfi-13 srfi-42 irregex
    3333                (only posix setenv))
    3434
     
    6363                        (and handle (tag-pointer handle *ihandle-tag*)))))
    6464
    65 (define ihandle-list->blob
    66         (letrec ([size
    67                   (foreign-value "sizeof(Ihandle *)" int)]
    68                                          [make-handle-block
    69                                           (lambda (n)
    70                                                 (make-blob (* n size)))]
    71                                          [handle-block-set!
    72                                           (foreign-lambda* void ([blob block] [int i] [ihandle handle])
    73                                                         "((Ihandle **)block)[i] = handle;")])
    74                 (lambda (lst)
    75                         (let ([block (make-handle-block (add1 (length lst)))])
    76                                 (do-ec (:list handle (index i) lst '(#f))
    77                                         (handle-block-set! block i handle))
    78                                 block))))
     65(define (ihandle-list->pointer-vector lst)
     66        (let ([ptrs (make-pointer-vector (add1 (length lst)) #f)])
     67                (do-ec (:list handle (index i) lst)
     68                        (begin
     69                                (ensure ihandle? handle)
     70                                (pointer-vector-set! ptrs i handle)))
     71                ptrs))
    7972
    8073(define (istatus->integer status)
     
    114107(define (string->iname default-case)
    115108        (let ([specials
    116                (regexp
     109               (irregex
    117110                 (case default-case
    118111                         [(upcase)   "[-a-z]"]
     
    121114                (lambda (name)
    122115                        (cond
    123                                 [(or (not name) (string-search specials name))
     116                                [(or (not name) (irregex-search specials name))
    124117                                 name]
    125118                                [else
     
    375368                                         [get/pointer
    376369                                          (foreign-lambda c-pointer "IupGetCallback" nonnull-ihandle iname/upcase)]
     370                                         [sigils
     371                                          (irregex "([bifdsvh]*)(?:=([bifdvh]))?")]
    377372                                         [callback-set!
    378373                                          (lambda (handle name proc)
    379374                                                (let* ([sig
    380375                                                        (cond
    381                                                                                                 [(string-match "([bifdsvh]*)(?:=([bifdvh]))?" (or (signature/raw handle name) ""))
     376                                                                                                [(irregex-match sigils (or (signature/raw handle name) ""))
    382377                                                                                                 => (lambda (groups)
    383                                                                                                                         (string-append (or (caddr groups) "i") (cadr groups)))]
     378                                                                                                                        (string-append
     379                                                                                                                                (or (irregex-match-substring groups 2) "i")
     380                                                                                                                                (irregex-match-substring groups 1)))]
    384381                                                                                                [else
    385382                                                                                                 (error 'callback-set! "callback has bad signature" handle name)])]
  • release/4/iup/trunk/iup-types.scm

    r20570 r20671  
    33        (pointer->ihandle #f))
    44
    5 (define-foreign-type ihandle-list blob
    6         ihandle-list->blob)
     5(define-foreign-type ihandle-list nonnull-pointer-vector
     6        ihandle-list->pointer-vector)
    77
    88(define-foreign-type nonnull-ihandle (nonnull-c-pointer "Ihandle")
  • release/4/iup/trunk/iup.setup

    r20583 r20671  
    1111                 'iup-base
    1212                 '("iup-base.so" "iup-base.o" "iup-base.import.so" "iup-types.scm")
    13                  '((version 1.0.1)
     13                 '((version 1.0.2)
    1414                         (static "iup-base.o")
    1515                         (static-options "-lcallback -liup -liupim -liupimglib")))
     
    2222                 'iup-controls
    2323                 '("iup-controls.so" "iup-controls.o" "iup-controls.import.so")
    24                  '((version 1.0.1)
     24                 '((version 1.0.2)
    2525                         (static "iup-controls.o")
    2626                         (static-options "-liup -liupcontrols")))
     
    3333                 'iup-dialogs
    3434                 '("iup-dialogs.so" "iup-dialogs.o" "iup-dialogs.import.so")
    35                  '((version 1.0.1)
     35                 '((version 1.0.2)
    3636                         (static "iup-dialogs.o")
    3737                         (static-options "-liup")))
     
    4646                                 'iup-glcanvas
    4747                                 '("iup-glcanvas.so" "iup-glcanvas.o" "iup-glcanvas.import.so")
    48                                  '((version 1.0.1)
     48                                 '((version 1.0.2)
    4949                                         (static "iup-glcanvas.o")
    5050                                         (static-options "-liup -liupgl"))))
     
    6060                                 'iup-pplot
    6161                                 '("iup-pplot.so" "iup-pplot.o" "iup-pplot.import.so")
    62                                  '((version 1.0.1)
     62                                 '((version 1.0.2)
    6363                                         (static "iup-pplot.o")
    6464                                         (static-options "-liup -liup_pplot"))))
     
    7272                 'iup
    7373                 '("iup.so" "iup.o" "iup.import.so")
    74                  '((version 1.0.1)
     74                 '((version 1.0.2)
    7575                         (static "iup.o"))))
    7676        (warning "IUP not found, bindings will not be compiled"))
     
    8383 'iup-dynamic
    8484 '("iup-dynamic.so" "iup-dynamic.o" "iup-dynamic.import.so")
    85  '((version 1.0.1)
     85 '((version 1.0.2)
    8686   (static "iup-dynamic.o")))
Note: See TracChangeset for help on using the changeset viewer.