;;;; macosx-url.scm
;;;; Kon Lovett, Mar '09


;;; Prelude

(declare
  (usual-integrations)
  (inline)
  (local)
  (number-type fixnum)
  (no-procedure-checks)
  (bound-to-procedure
    ##sys#check-string ) )


;;;

#>
#include <ApplicationServices/ApplicationServices.h>
#include <CoreFoundation/CoreFoundation.h>

static int
open_url( const char *urlstr, int len )
{
	OSStatus sta = EXIT_FAILURE;
	CFURLRef url = CFURLCreateWithBytes( NULL, (const UInt8 *) urlstr, len, kCFStringEncodingASCII, NULL );
	if (NULL != url) {
		sta = LSOpenCFURLRef( url, NULL );
		CFRelease( url );
	}
	return sta;
}
<#


;;;

(require-library dollar)

(module macosx-url (open-url)

(import scheme chicken foreign dollar)

;;

(define (make-exn-condition loc msg . args)
  (make-property-condition 'exn 'location loc 'message msg 'arguments args) )

(define (make-osstatus-condition sta)
  (make-property-condition 'osstatus 'code sta) )

(define (make-exn-osstatus-condition loc msg sta . args)
  (make-composite-condition
   (apply make-exn-condition loc msg args)
   (make-osstatus-condition sta)) )

;;

(define (osstatus-error loc msg osstatus . args)
  (abort (apply make-exn-osstatus-condition loc msg osstatus args)) )

;;

(define (open-url url)
  (##sys#check-string url 'open-url)
	(let ((sta ($ int open_url (c-string url) (int (string-length url)))))
	  (unless (zero? sta) (osstatus-error 'open-url "open url failed" sta url))))

) ;module macosx-url