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

..

Browse Source 
original commit: 5326de1baf4601f4a8b9260ce80b24707e4a62d8
This commit is contained in:
Robby Findler 2002-03-04 18:10:53 +00:00
parent 549c0585aa
commit ae621ddd83
1 changed files with 57 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
collects/net/sendurl.ss
View File

@ -1,58 +1,67 @@
(module sendurl mzscheme
(require (lib "process.ss")
(lib "file.ss"))
(lib "file.ss")
(lib "etc.ss"))
(provide send-url)
; send-url : str -> void
(define (send-url str)
(parameterize ([current-input-port null-input]
[current-error-port null-output] ; comment out this line to see error messages
[current-output-port null-output])
(case (system-type)
[(macos macosx)
;; actually, I think GURL means something slightly different...
(send-event "MACS" "GURL" "GURL" str)]
[(windows)
;; Try to get a MrEd function...
(let ([get-res (with-handlers ([not-break-exn? (lambda (x) #f)])
(dynamic-require '(lib "mred.ss" "mred") 'get-resource))])
(if get-res
(let ([b (box "")])
(unless (get-res "HKEY_CLASSES_ROOT" "htmlfile\\shell\\open\\command" b)
(error 'send-url "couldn't find URL opener in the registry"))
(let-values ([(out in id err status) (apply
values
(process (format "~a ~a" (unbox b) str)))])
(close-output-port in)
(close-input-port out)
(close-input-port err)))
(error 'send-url "don't know how to open URL in Windows without MrEd")))]
[(unix)
(let ([preferred (get-preference 'external-browser (lambda () #f))])
(cond
[(and (or (not preferred)
(eq? preferred 'opera))
(find-executable-path "opera" #f))
=>
(lambda (browser-path)
;; opera may not return -- always open asyncronously
;; opera starts a new browser automatically, if it can't find one
;; We no longer pass ,new-window since the teachpack always calls send-url now.
(process*/close-ports browser-path "-remote" (format "openURL(~a)" str)))]
[(and (and (or (not preferred)
(eq? preferred 'netscape)))
(find-executable-path "netscape" #f))
=>
(lambda (browser-path)
;; netscape's -remote returns with an error code, if no
;; netscape is around. start a new netscape in that case.
(or (system* browser-path "-remote" (format "openURL(~a)" str))
(process*/close-ports browser-path str)))]
[else
(error 'open-url "Couldn't find Netscape or Opera to open URL: ~e" str)]))]
[else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))])))
(define send-url
(opt-lambda (str [separate-window? #t])
(parameterize ([current-input-port null-input]
[current-error-port null-output] ; comment out this line to see error messages
[current-output-port null-output])
(case (system-type)
[(macos macosx)
;; actually, I think GURL means something slightly different...
(send-event "MACS" "GURL" "GURL" str)]
[(windows)
;; Try to get a MrEd function...
(let ([get-res (with-handlers ([not-break-exn? (lambda (x) #f)])
(dynamic-require '(lib "mred.ss" "mred") 'get-resource))])
(if get-res
(let ([b (box "")])
(unless (get-res "HKEY_CLASSES_ROOT" "htmlfile\\shell\\open\\command" b)
(error 'send-url "couldn't find URL opener in the registry"))
(let-values ([(out in id err status) (apply
values
(process (format "~a ~a" (unbox b) str)))])
(close-output-port in)
(close-input-port out)
(close-input-port err)))
(error 'send-url "don't know how to open URL in Windows without MrEd")))]
[(unix)
(let ([preferred (get-preference 'external-browser (lambda () #f))])
(cond
[(and (or (not preferred)
(eq? preferred 'opera))
(find-executable-path "opera" #f))
=>
(lambda (browser-path)
;; opera may not return -- always open asyncronously
;; opera starts a new browser automatically, if it can't find one
(process*/close-ports browser-path "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" str)
str))))]
[(and (and (or (not preferred)
(eq? preferred 'netscape)))
(find-executable-path "netscape" #f))
=>
(lambda (browser-path)
;; netscape's -remote returns with an error code, if no
;; netscape is around. start a new netscape in that case.
(or (system* browser-path "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" str)
str)))
(process*/close-ports browser-path str)))]
[else
(error 'open-url "Couldn't find Netscape or Opera to open URL: ~e" str)]))]
[else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))]))))
; null-input : iport
(define null-input