(require-dll "w32.dll")
(require "w32struct.scm")

(define CeRapiInit 
  (w32:foreign-procedure "rapi.dll" "CeRapiInit" '(w32api handle)))
(define CeRapiUninit 
  (w32:foreign-procedure "rapi.dll" "CeRapiUninit" '(w32api handle)))
(define CeCloseHandle
  (w32:foreign-procedure "rapi.dll" "CeCloseHandle" '(w32api bool handle)))
(define CeCreateProcess
  (w32:foreign-procedure "rapi.dll" "CeCreateProcess" 
    '(w32api bool lpcwstr lpcwstr lpvoid lpvoid bool dword lpvoid lpwstr lpvoid lpvoid)))
(define CeGetLastError
  (w32:foreign-procedure "rapi.dll" "CeGetLastError" '(w32api dword)))

(w32:declare-foreign-struct PROCESS_INFORMATION 
  (process thread process-id thread-id)
  #(handle handle dword dword))

(define-macro (unwind-protect form . unwind-forms)
  `(dynamic-wind
     (lambda () #t) (lambda () ,form) (lambda () ,@unwind-forms)))

(define (hresult-check res msg)
  (if (and (foreign? res) (not (zero? (bit-and #x80000000 res))))
    (error msg res)
    res))

(define (bool-check res msg)
  (if (not res) (error msg (cegetlasterror)) res))

(define (ce-run proggy . parms)
  (hresult-check (cerapiinit) "RAPI Init failed")
  (unwind-protect
    (let ((pi (make-PROCESS_INFORMATION)))
      (bool-check (cecreateprocess proggy (apply string-unbreakup (list parms " ")) 
                    #f #f #f 0 #f #f #f pi) "Spawn failed")
      (ceclosehandle (PROCESS_INFORMATION-process pi))
      (ceclosehandle (PROCESS_INFORMATION-thread pi)))
    (cerapiuninit))
  "Successfully spawned")