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

fixed error reporting

Browse Source 
original commit: 7ab9526c21855ab623ee427bfdb94cd6c90e68e6
This commit is contained in:
Paul Graunke 2002-07-09 20:25:37 +00:00
parent 3b38ee00be
commit 04a3da9994
1 changed files with 53 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
collects/net/sendurl.ss
View File

@ -12,56 +12,58 @@
; send-url : str -> void ; send-url : str -> void
(define send-url (define send-url
(opt-lambda (str [separate-window? separate-by-default?]) (opt-lambda (str [separate-window? separate-by-default?])
(parameterize ([current-input-port null-input] ; The with-handler reverts to the old error port before printing raised error messages.
[current-error-port null-output] ; comment out this line to see error messages (with-handlers ([void (lambda (exn) (raise exn))])
[current-output-port null-output]) (parameterize ([current-input-port null-input]
(cond [current-error-port null-output]
[(eq? (system-type) 'macos) [current-output-port null-output])
;; actually, I think GURL means something slightly different... (cond
(send-event "MACS" "GURL" "GURL" str)] [(eq? (system-type) 'macos)
[(or (eq? (system-type) 'macosx) ;; actually, I think GURL means something slightly different...
(equal? "ppc-macosxonx" (system-library-subpath))) (send-event "MACS" "GURL" "GURL" str)]
(system (format "osascript -e 'open location \"~a\"'" str))] [(or (eq? (system-type) 'macosx)
[(eq? (system-type) 'windows) (equal? "ppc-macosxonx" (system-library-subpath)))
(shell-execute #f str "" (current-directory) 'SW_SHOWNORMAL)] (system (format "osascript -e 'open location \"~a\"'" str))]
[(eq? (system-type) 'unix) [(eq? (system-type) 'windows)
(let ([preferred (get-preference 'external-browser (lambda () #f))]) (shell-execute #f str "" (current-directory) 'SW_SHOWNORMAL)]
(cond [(eq? (system-type) 'unix)
[(use-browser 'opera preferred) (let ([preferred (get-preference 'external-browser (lambda () #f))])
=> (cond
(lambda (browser-path) [(use-browser 'opera preferred)
;; opera may not return -- always open asyncronously =>
;; opera starts a new browser automatically, if it can't find one (lambda (browser-path)
(process*/close-ports browser-path "-remote" ;; opera may not return -- always open asyncronously
(format "openURL(~a)" ;; opera starts a new browser automatically, if it can't find one
(if separate-window? (process*/close-ports browser-path "-remote"
(format "~a,new-window" str) (format "openURL(~a)"
str))))] (if separate-window?
[(use-browser 'galeon preferred) (format "~a,new-window" str)
=> str))))]
(lambda (browser-path) [(use-browser 'galeon preferred)
(process*/close-ports browser-path =>
(if separate-window? "-w" "-x") (lambda (browser-path)
str))] (process*/close-ports browser-path
[(or (use-browser 'netscape preferred) (if separate-window? "-w" "-x")
(use-browser 'mozilla preferred)) str))]
=> [(or (use-browser 'netscape preferred)
(lambda (browser-path) (use-browser 'mozilla preferred))
;; netscape's -remote returns with an error code, if no =>
;; netscape is around. start a new netscape in that case. (lambda (browser-path)
(or (system* browser-path "-remote" ;; netscape's -remote returns with an error code, if no
(format "openURL(~a)" ;; netscape is around. start a new netscape in that case.
(if separate-window? (or (system* browser-path "-remote"
(format "~a,new-window" str) (format "openURL(~a)"
str))) (if separate-window?
(process*/close-ports browser-path str)))] (format "~a,new-window" str)
[(use-browser 'dillo preferred) str)))
=> (process*/close-ports browser-path str)))]
(lambda (browser-path) [(use-browser 'dillo preferred)
(process*/close-ports browser-path str))] =>
[else (lambda (browser-path)
(error 'open-url "Couldn't find Opera, Galeon, Mozilla, Netscape, or Dillo to open URL: ~e" str)]))] (process*/close-ports browser-path str))]
[else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))])))) [else
(error 'open-url "Couldn't find Opera, Galeon, Mozilla, Netscape, or Dillo to open URL: ~e" str)]))]
[else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))])))))
; : sym sym -> (U #f str) ; : sym sym -> (U #f str)
; to find the path for the named browser, unless another browser is preferred ; to find the path for the named browser, unless another browser is preferred