suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 25afbe47245d9e6249901bdb374eccad5d941f0e
This commit is contained in:
Matthew Flatt 2002-07-09 21:17:14 +00:00
parent 04a3da9994
commit f3a76d6851
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/net/sendurl.ss
View File

@ -18,9 +18,23 @@
[current-error-port null-output]
[current-output-port null-output])
(cond
[(eq? (system-type) 'macos)
;; actually, I think GURL means something slightly different...
(send-event "MACS" "GURL" "GURL" str)]
[(eq? (system-type) 'macos)
(let loop ([l '("NAVG" "MSIE")])
(if (null? l)
(error 'send-url "couldn't start Internet Explorer or Netscape")
(with-handlers ([not-break-exn? (lambda (x) (loop (cdr l)))])
(subprocess #f #f #f "by-id" (car l))
(let loop ([retries 2]) ;; <<< Yuck <<<
(if (zero? retries)
(error "enough already") ; caught above
(with-handlers ([not-break-exn? (lambda (x)
(loop (sub1 retries)))])
(let ([t (thread (lambda ()
(send-event (car l) "GURL" "GURL" str)))])
(object-wait-multiple 1 t) ;; <<< Yuck (timeout) <<<
(when (thread-running? t)
(kill-thread t)
(error "timeout")))))))))]
[(or (eq? (system-type) 'macosx)
(equal? "ppc-macosxonx" (system-library-subpath)))
(system (format "osascript -e 'open location \"~a\"'" str))]