Changeset 14212 in project


Ignore:
Timestamp:
04/09/09 16:47:37 (11 years ago)
Author:
Kon Lovett
Message:

Release.

Location:
release/4/macosx
Files:
2 added
4 edited
6 copied

Legend:

Unmodified
Added
Removed
  • release/4/macosx/tags/2.1.0/macosx-env.scm

    r14206 r14212  
    2121  (no-procedure-checks)
    2222  (bound-to-procedure
    23     ##sys#check-number))
     23    ##sys#check-syntax))
    2424
    2525;;;
     
    207207;;;
    208208
    209 (require-library dollar)
    210 
    211209(module macosx-env (;export
    212210  session-info
     
    223221  tick-count
    224222  delay-for-ticks
    225   gestalt)
    226 
    227 (import scheme chicken foreign dollar)
    228 
    229 ;;
    230 
    231 (define (make-exn-condition loc msg . args)
    232   (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
    233 
    234 (define (make-osstatus-condition code)
    235   (make-property-condition 'osstatus 'code code) )
    236 
    237 (define (make-oserr-condition code)
    238   (make-property-condition 'oserr 'code code) )
    239 
    240 (define (make-exn-osstatus-condition loc msg code . args)
    241   (make-composite-condition
    242    (apply make-exn-condition loc msg args)
    243    (make-osstatus-condition code)) )
    244 
    245 (define (make-exn-oserr-condition loc msg code . args)
    246   (make-composite-condition
    247    (apply make-exn-condition loc msg args)
    248    (make-oserr-condition code)) )
    249 
    250 ;;
    251 
    252 (define (osstatus-error loc msg code . args)
    253   (abort (apply make-exn-osstatus-condition loc msg code args)) )
    254 
    255 (define (oserr-error loc msg code . args)
    256   (abort (apply make-exn-oserr-condition loc msg code args)) )
     223  gestalt
     224  ;;
     225  osstatus-condition?
     226  oserr-condition?)
     227
     228(import scheme chicken foreign dollar
     229  (only type-checks
     230    check-number)
     231  (only macosx-errors
     232    exception-osstatus osstatus-condition?  exception-oserr oserr-condition?))
     233
     234(require-library dollar type-checks macosx-errors)
    257235
    258236;;
     
    284262                 (sab unsigned-integer32))
    285263    (let ((sta ($ int sessionInfo #$sid #$sab)))
    286       (if (not (fx= 0 sta)) (osstatus-error 'session-info "SessionGetInfo failed" sta)
     264      (if (not (fx= 0 sta)) (exception-osstatus 'session-info "SessionGetInfo failed" sta)
    287265          (let-location ((uid unsigned-integer32)
    288266                         (con unsigned-integer32)
    289267                         (bits unsigned-integer32))
    290268            (let ((nam ($/string:out#1 sessionInfoProperties #$uid #$con #$bits)))
    291               (if (not nam) (osstatus-error 'session-info "CGSessionCopyCurrentDictionary failed" 0)
     269              (if (not nam)
     270                  (exception-osstatus 'session-info "CGSessionCopyCurrentDictionary failed" 0)
    292271                  (vector sid
    293272                          (bitwise-test?/foreign-mask sab "sessionIsRoot")
     
    319298;;
    320299
    321 (define (computer-name #!optional (store #f)) ($/string:out#1 computer_name (c-pointer store)))
     300(define (computer-name #!optional (store #f))
     301  ($/string:out#1 computer_name (c-pointer store)) )
    322302
    323303(define (console-user #!optional (store #f))
     
    327307                      (vector nam uid gid) ) ) ) )
    328308
    329 (define (local-host-name #!optional (store #f)) ($/string:out#1 local_host_name (c-pointer store)))
    330 
    331 (define (location-name #!optional (store #f)) ($/string:out#1 location_name (c-pointer store)))
     309(define (local-host-name #!optional (store #f))
     310  ($/string:out#1 local_host_name (c-pointer store)) )
     311
     312(define (location-name #!optional (store #f))
     313  ($/string:out#1 location_name (c-pointer store)) )
    332314
    333315;;
     
    349331  (when (symbol? sel) (set! sel (symbol->string sel)))
    350332  (when (string? sel) (set! sel ($ unsigned-integer32 stringToOSType (nonnull-c-string sel))))
    351   (##sys#check-number sel 'gestalt)
     333  (check-number 'gestalt sel)
    352334        (let-location ((resp long))
    353335    (let ((err ($ short Gestalt (unsigned-integer32 sel) #$resp)))
    354336      (if (fx= 0 err) resp
    355           (oserr-error 'gestalt "Gestalt failed" err) ) ) ) )
     337          (exception-oserr 'gestalt "Gestalt failed" err) ) ) ) )
    356338
    357339) ;module macosx-env
  • release/4/macosx/tags/2.1.0/macosx-url.scm

    r14206 r14212  
    1010  (local)
    1111  (number-type fixnum)
    12   (no-procedure-checks)
    13   (bound-to-procedure
    14     ##sys#check-string ) )
     12  (no-procedure-checks))
    1513
    1614
     
    2523{
    2624        OSStatus sta = EXIT_FAILURE;
    27         CFURLRef url = CFURLCreateWithBytes( NULL, (const UInt8 *) urlstr, len, kCFStringEncodingASCII, NULL );
     25        CFURLRef url
     26          = CFURLCreateWithBytes( NULL, (const UInt8 *) urlstr, len, kCFStringEncodingASCII, NULL );
    2827        if (NULL != url) {
    2928                sta = LSOpenCFURLRef( url, NULL );
     
    3736;;;
    3837
    39 (require-library dollar)
     38(module macosx-url (;export
     39  open-url
     40  ;;
     41  osstatus-condition?)
    4042
    41 (module macosx-url (open-url)
     43(import scheme chicken foreign dollar
     44  (only type-checks check-string)
     45  (only macosx-errors exception-osstatus osstatus-condition?))
    4246
    43 (import scheme chicken foreign dollar)
     47(require-library dollar type-checks macosx-errors)
    4448
    45 ;;
    46 
    47 (define (make-exn-condition loc msg . args)
    48   (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
    49 
    50 (define (make-osstatus-condition sta)
    51   (make-property-condition 'osstatus 'code sta) )
    52 
    53 (define (make-exn-osstatus-condition loc msg sta . args)
    54   (make-composite-condition
    55    (apply make-exn-condition loc msg args)
    56    (make-osstatus-condition sta)) )
    57 
    58 ;;
    59 
    60 (define (osstatus-error loc msg osstatus . args)
    61   (abort (apply make-exn-osstatus-condition loc msg osstatus args)) )
    6249
    6350;;
    6451
    6552(define (open-url url)
    66   (##sys#check-string url 'open-url)
     53  (check-string 'open-url url)
    6754        (let ((sta ($ int open_url (c-string url) (int (string-length url)))))
    68           (unless (zero? sta) (osstatus-error 'open-url "open url failed" sta url))))
     55          (unless (zero? sta)
     56            (exception-osstatus 'open-url "CFURLCreateWithBytes failed" sta url) ) ) )
    6957
    7058) ;module macosx-url
  • release/4/macosx/tags/2.1.0/macosx.meta

    r14206 r14212  
    77 (doc-from-wiki)
    88 (synopsis "MacOS X Utilities")
    9  (needs setup-helper)
     9 (needs check-errors setup-helper)
    1010 (files
    1111  "tests"
    12   "macosx.scm"
     12  "macosx-errors.scm"
     13  "macosx-env.scm"
     14  "macosx-url.scm"
    1315  "macosx.setup") )
  • release/4/macosx/tags/2.1.0/macosx.setup

    r14206 r14212  
    55(verify-extension-name "macosx")
    66
    7 (setup-shared-extension-module 'macosx-url (extension-version "2.0.0")
     7(setup-shared-extension-module 'macosx-errors (extension-version "2.1.0"))
     8
     9(setup-shared-extension-module 'macosx-url (extension-version "2.1.0")
    810  compile-options: '(
    911    -extend dollar
    1012    -framework CoreFoundation -framework ApplicationServices))
    1113
    12 (setup-shared-extension-module 'macosx-env (extension-version "2.0.0")
     14(setup-shared-extension-module 'macosx-env (extension-version "2.1.0")
    1315  compile-options: '(
    1416    -extend dollar
     
    1719    -framework Security
    1820    -framework ApplicationServices))
     21
     22(install-extension 'macosx '() `((version ,(extension-version "2.1.0"))))
  • release/4/macosx/trunk/macosx-env.scm

    r13844 r14212  
    2121  (no-procedure-checks)
    2222  (bound-to-procedure
    23     ##sys#check-number))
     23    ##sys#check-syntax))
    2424
    2525;;;
     
    207207;;;
    208208
    209 (require-library dollar)
    210 
    211209(module macosx-env (;export
    212210  session-info
     
    223221  tick-count
    224222  delay-for-ticks
    225   gestalt)
    226 
    227 (import scheme chicken foreign dollar)
    228 
    229 ;;
    230 
    231 (define (make-exn-condition loc msg . args)
    232   (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
    233 
    234 (define (make-osstatus-condition code)
    235   (make-property-condition 'osstatus 'code code) )
    236 
    237 (define (make-oserr-condition code)
    238   (make-property-condition 'oserr 'code code) )
    239 
    240 (define (make-exn-osstatus-condition loc msg code . args)
    241   (make-composite-condition
    242    (apply make-exn-condition loc msg args)
    243    (make-osstatus-condition code)) )
    244 
    245 (define (make-exn-oserr-condition loc msg code . args)
    246   (make-composite-condition
    247    (apply make-exn-condition loc msg args)
    248    (make-oserr-condition code)) )
    249 
    250 ;;
    251 
    252 (define (osstatus-error loc msg code . args)
    253   (abort (apply make-exn-osstatus-condition loc msg code args)) )
    254 
    255 (define (oserr-error loc msg code . args)
    256   (abort (apply make-exn-oserr-condition loc msg code args)) )
     223  gestalt
     224  ;;
     225  osstatus-condition?
     226  oserr-condition?)
     227
     228(import scheme chicken foreign dollar
     229  (only type-checks
     230    check-number)
     231  (only macosx-errors
     232    exception-osstatus osstatus-condition?  exception-oserr oserr-condition?))
     233
     234(require-library dollar type-checks macosx-errors)
    257235
    258236;;
     
    284262                 (sab unsigned-integer32))
    285263    (let ((sta ($ int sessionInfo #$sid #$sab)))
    286       (if (not (fx= 0 sta)) (osstatus-error 'session-info "SessionGetInfo failed" sta)
     264      (if (not (fx= 0 sta)) (exception-osstatus 'session-info "SessionGetInfo failed" sta)
    287265          (let-location ((uid unsigned-integer32)
    288266                         (con unsigned-integer32)
    289267                         (bits unsigned-integer32))
    290268            (let ((nam ($/string:out#1 sessionInfoProperties #$uid #$con #$bits)))
    291               (if (not nam) (osstatus-error 'session-info "CGSessionCopyCurrentDictionary failed" 0)
     269              (if (not nam)
     270                  (exception-osstatus 'session-info "CGSessionCopyCurrentDictionary failed" 0)
    292271                  (vector sid
    293272                          (bitwise-test?/foreign-mask sab "sessionIsRoot")
     
    319298;;
    320299
    321 (define (computer-name #!optional (store #f)) ($/string:out#1 computer_name (c-pointer store)))
     300(define (computer-name #!optional (store #f))
     301  ($/string:out#1 computer_name (c-pointer store)) )
    322302
    323303(define (console-user #!optional (store #f))
     
    327307                      (vector nam uid gid) ) ) ) )
    328308
    329 (define (local-host-name #!optional (store #f)) ($/string:out#1 local_host_name (c-pointer store)))
    330 
    331 (define (location-name #!optional (store #f)) ($/string:out#1 location_name (c-pointer store)))
     309(define (local-host-name #!optional (store #f))
     310  ($/string:out#1 local_host_name (c-pointer store)) )
     311
     312(define (location-name #!optional (store #f))
     313  ($/string:out#1 location_name (c-pointer store)) )
    332314
    333315;;
     
    349331  (when (symbol? sel) (set! sel (symbol->string sel)))
    350332  (when (string? sel) (set! sel ($ unsigned-integer32 stringToOSType (nonnull-c-string sel))))
    351   (##sys#check-number sel 'gestalt)
     333  (check-number 'gestalt sel)
    352334        (let-location ((resp long))
    353335    (let ((err ($ short Gestalt (unsigned-integer32 sel) #$resp)))
    354336      (if (fx= 0 err) resp
    355           (oserr-error 'gestalt "Gestalt failed" err) ) ) ) )
     337          (exception-oserr 'gestalt "Gestalt failed" err) ) ) ) )
    356338
    357339) ;module macosx-env
  • release/4/macosx/trunk/macosx-url.scm

    r13844 r14212  
    1010  (local)
    1111  (number-type fixnum)
    12   (no-procedure-checks)
    13   (bound-to-procedure
    14     ##sys#check-string ) )
     12  (no-procedure-checks))
    1513
    1614
     
    2523{
    2624        OSStatus sta = EXIT_FAILURE;
    27         CFURLRef url = CFURLCreateWithBytes( NULL, (const UInt8 *) urlstr, len, kCFStringEncodingASCII, NULL );
     25        CFURLRef url
     26          = CFURLCreateWithBytes( NULL, (const UInt8 *) urlstr, len, kCFStringEncodingASCII, NULL );
    2827        if (NULL != url) {
    2928                sta = LSOpenCFURLRef( url, NULL );
     
    3736;;;
    3837
    39 (require-library dollar)
     38(module macosx-url (;export
     39  open-url
     40  ;;
     41  osstatus-condition?)
    4042
    41 (module macosx-url (open-url)
     43(import scheme chicken foreign dollar
     44  (only type-checks check-string)
     45  (only macosx-errors exception-osstatus osstatus-condition?))
    4246
    43 (import scheme chicken foreign dollar)
     47(require-library dollar type-checks macosx-errors)
    4448
    45 ;;
    46 
    47 (define (make-exn-condition loc msg . args)
    48   (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
    49 
    50 (define (make-osstatus-condition sta)
    51   (make-property-condition 'osstatus 'code sta) )
    52 
    53 (define (make-exn-osstatus-condition loc msg sta . args)
    54   (make-composite-condition
    55    (apply make-exn-condition loc msg args)
    56    (make-osstatus-condition sta)) )
    57 
    58 ;;
    59 
    60 (define (osstatus-error loc msg osstatus . args)
    61   (abort (apply make-exn-osstatus-condition loc msg osstatus args)) )
    6249
    6350;;
    6451
    6552(define (open-url url)
    66   (##sys#check-string url 'open-url)
     53  (check-string 'open-url url)
    6754        (let ((sta ($ int open_url (c-string url) (int (string-length url)))))
    68           (unless (zero? sta) (osstatus-error 'open-url "open url failed" sta url))))
     55          (unless (zero? sta)
     56            (exception-osstatus 'open-url "CFURLCreateWithBytes failed" sta url) ) ) )
    6957
    7058) ;module macosx-url
  • release/4/macosx/trunk/macosx.meta

    r13825 r14212  
    77 (doc-from-wiki)
    88 (synopsis "MacOS X Utilities")
    9  (needs setup-helper)
     9 (needs check-errors setup-helper)
    1010 (files
    1111  "tests"
    12   "macosx.scm"
     12  "macosx-errors.scm"
     13  "macosx-env.scm"
     14  "macosx-url.scm"
    1315  "macosx.setup") )
  • release/4/macosx/trunk/macosx.setup

    r13588 r14212  
    55(verify-extension-name "macosx")
    66
    7 (setup-shared-extension-module 'macosx-url (extension-version "2.0.0")
     7(setup-shared-extension-module 'macosx-errors (extension-version "2.1.0"))
     8
     9(setup-shared-extension-module 'macosx-url (extension-version "2.1.0")
    810  compile-options: '(
    911    -extend dollar
    1012    -framework CoreFoundation -framework ApplicationServices))
    1113
    12 (setup-shared-extension-module 'macosx-env (extension-version "2.0.0")
     14(setup-shared-extension-module 'macosx-env (extension-version "2.1.0")
    1315  compile-options: '(
    1416    -extend dollar
     
    1719    -framework Security
    1820    -framework ApplicationServices))
     21
     22(install-extension 'macosx '() `((version ,(extension-version "2.1.0"))))
Note: See TracChangeset for help on using the changeset viewer.