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

separate functions for each platform, simplifies code

Browse Source 
svn: r8443
This commit is contained in:
Eli Barzilay 2008-01-28 09:40:28 +00:00
parent 073ca0d558
commit 3942c9d275
1 changed files with 40 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/net/sendurl.ss
View File

@ -45,24 +45,25 @@
;; send-url : str [bool] -> void ;; send-url : str [bool] -> void
(define (send-url url-str [separate-window? separate-by-default?]) (define (send-url url-str [separate-window? separate-by-default?])
(define external (external-browser))
(define stype (force systype)) (define stype (force systype))
(define preferred '|? ? ?|) (cond [(not (string? url-str))
(define (use-browser browser-name) (error 'send-url "expected a string, got ~e" url-str)]
(when (eq? preferred '|? ? ?|) [(procedure? (external-browser)) ((external-browser) url-str)]
(set! preferred (or external (get-preference 'external-browser)))) [else (case stype
(and (or (not preferred) (eq? preferred browser-name)) [(macosx) (send-url/mac url-str)]
(find-executable-path (symbol->string browser-name) #f))) [(windows) (send-url/win url-str)]
(unless (string? url-str) [(unix) (send-url/unix url-str separate-window?)]
(error 'send-url "expected a string, got ~e" url-str)) [else (error 'send-url
(cond "don't know how to open URL on platform: ~s"
[(procedure? external) (external url-str)] stype)])])
[(eq? stype 'macosx) (void))
(browser-process (format "osascript -e 'open location \"~a\"'" url-str))]
[(eq? stype 'windows) (define (send-url/mac url-str)
(let ([simple (browser-process (format "osascript -e 'open location \"~a\"'" url-str)))
(lambda ()
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL))]) (define (send-url/win url-str)
(define (simple)
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL))
(if (regexp-match #rx"#" url-str) (if (regexp-match #rx"#" url-str)
;; complex case: need to launch the browser directly, ;; complex case: need to launch the browser directly,
;; otherwise the fragment is ignored. Use `ftype' to discover ;; otherwise the fragment is ignored. Use `ftype' to discover
@ -78,10 +79,14 @@
;; give up and use simple mode ;; give up and use simple mode
(simple))))) (simple)))))
;; simple case: no fragment ;; simple case: no fragment
(simple)))] (simple)))
[(not (eq? stype 'unix))
(error 'send-url "don't know how to open URL on platform: ~s" stype)] (define (send-url/unix url-str separate-window?)
;; unix (define preferred (or (external-browser) (get-preference 'external-browser)))
(define (use-browser browser-name)
(and (or (not preferred) (eq? preferred browser-name))
(find-executable-path (symbol->string browser-name) #f)))
(cond
[(use-browser 'opera) [(use-browser 'opera)
=> (lambda (exe) => (lambda (exe)
;; opera may not return -- always open asyncronously ;; opera may not return -- always open asyncronously
@ -116,8 +121,9 @@
(cdr preferred))]) (cdr preferred))])
(browser-process cmd))] (browser-process cmd))]
[else [else
(error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]) (error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]))
(void))
;; Process helpers
;; run-browser : process-proc list-of-strings -> void ;; run-browser : process-proc list-of-strings -> void
(define (run-browser process*/ports args) (define (run-browser process*/ports args)