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

.

Browse Source 
original commit: 0ddcf321358b488cc72258d20c236bcc45251b74
This commit is contained in:
Paul Graunke 2002-09-06 18:35:02 +00:00
parent 0e1ca2f6e6
commit f8aa46a859
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/net/sendurl.ss
View File

@ -4,11 +4,20 @@
(lib "etc.ss") (lib "etc.ss")
(lib "sendevent.ss")) (lib "sendevent.ss"))
(provide send-url unix-browser-list) (provide send-url unix-browser-list browser-preference? external-browser)
(define separate-by-default? (define separate-by-default?
(get-preference 'new-browser-for-urls (lambda () #t))) (get-preference 'new-browser-for-urls (lambda () #t)))
; : any -> bool
(define (browser-preference? x)
(or (not x) (memq x unix-browser-list) (custom-browser? x)))
(define external-browser
(make-parameter
(get-preference 'external-browser (lambda () #f))
browser-preference?))
; send-url : str [bool] -> void ; send-url : str [bool] -> void
(define send-url (define send-url
(opt-lambda (url-str [separate-window? separate-by-default?]) (opt-lambda (url-str [separate-window? separate-by-default?])
@ -49,7 +58,7 @@
[(eq? (system-type) 'windows) [(eq? (system-type) 'windows)
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)] (shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)]
[(eq? (system-type) 'unix) [(eq? (system-type) 'unix)
(let ([preferred (get-preference 'external-browser (lambda () #f))]) (let ([preferred (external-browser)])
(cond (cond
[(use-browser 'opera preferred) [(use-browser 'opera preferred)
=> =>