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

.

Browse Source 
original commit: 8f247a6b6336687198bcc7fcbf00f14158f89b78
This commit is contained in:
Matthew Flatt 2002-07-25 17:37:57 +00:00
parent f3889f341e
commit dbbed8f02c
1 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/net/sendurl.ss
View File

@ -14,27 +14,32 @@
(opt-lambda (str [separate-window? separate-by-default?]) (opt-lambda (str [separate-window? separate-by-default?])
; The with-handler reverts to the old error port before printing raised error messages. ; The with-handler reverts to the old error port before printing raised error messages.
(with-handlers ([void (lambda (exn) (raise exn))]) (with-handlers ([void (lambda (exn) (raise exn))])
(printf "trying!~n")
(parameterize ([current-input-port null-input] (parameterize ([current-input-port null-input]
[current-error-port null-output] [current-error-port null-output]
[current-output-port null-output]) [current-output-port null-output])
(cond (cond
[(eq? (system-type) 'macos) [(eq? (system-type) 'macos)
(let loop ([l '("NAVG" "MSIE")]) (if (regexp-match "Blue Box" (system-type #t))
(if (null? l) ;; Classic inside OS X:
(error 'send-url "couldn't start Internet Explorer or Netscape") (let loop ([l '("MSIE" "NAVG")])
(with-handlers ([not-break-exn? (lambda (x) (loop (cdr l)))]) (if (null? l)
(subprocess #f #f #f "by-id" (car l)) (error 'send-url "couldn't start Internet Explorer or Netscape")
(let loop ([retries 2]) ;; <<< Yuck <<< (with-handlers ([not-break-exn? (lambda (x) (loop (cdr l)))])
(if (zero? retries) (subprocess #f #f #f "by-id" (car l))
(error "enough already") ; caught above (let loop ([retries 2]) ;; <<< Yuck <<<
(with-handlers ([not-break-exn? (lambda (x) (if (zero? retries)
(loop (sub1 retries)))]) (error "enough already") ; caught above
(let ([t (thread (lambda () (with-handlers ([not-break-exn? (lambda (x)
(send-event (car l) "GURL" "GURL" str)))]) (loop (sub1 retries)))])
(object-wait-multiple 1 t) ;; <<< Yuck (timeout) <<< (let ([t (thread (lambda ()
(when (thread-running? t) (send-event (car l) "GURL" "GURL" str)))])
(kill-thread t) (object-wait-multiple 1 t) ;; <<< Yuck (timeout) <<<
(error "timeout")))))))))] (when (thread-running? t)
(kill-thread t)
(error "timeout")))))))))
;; Normal OS Classic:
(send-event "MACS" "GURL" "GURL" str))]
[(or (eq? (system-type) 'macosx) [(or (eq? (system-type) 'macosx)
(equal? "ppc-macosxonx" (system-library-subpath))) (equal? "ppc-macosxonx" (system-library-subpath)))
(system (format "osascript -e 'open location \"~a\"'" str))] (system (format "osascript -e 'open location \"~a\"'" str))]