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

* scheme -> racket

Browse Source 
* Use `delay/sync' to fix possible races (should fix PR11788)

* Move Chrome up after firefox since it's very widely supported now

* Add xdg-open
This commit is contained in:
Eli Barzilay 2011-04-12 07:17:09 -04:00
parent 717a61840f
commit 52ca08a8a9
1 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/net/sendurl.rkt
View File

@ -1,12 +1,9 @@
;; The main client of this module is browser/external.ss ;; The main client of this module is browser/external.ss
;; (others just use the (send-url url [new?]) interface.) ;; (others just use the (send-url url [new?]) interface.)
#lang scheme/base #lang racket/base
(require scheme/system (require racket/system racket/file racket/promise racket/port)
scheme/file
scheme/promise
scheme/port)
(provide send-url send-url/file send-url/contents (provide send-url send-url/file send-url/contents
unix-browser-list browser-preference? external-browser) unix-browser-list browser-preference? external-browser)
@ -21,7 +18,8 @@
;; order matters: the default will be the first of these that is found ;; order matters: the default will be the first of these that is found
(define all-unix-browsers (define all-unix-browsers
'(;; common browsers '(;; common browsers
firefox galeon opera mozilla konqueror seamonkey epiphany google-chrome xdg-open
firefox google-chrome galeon opera mozilla konqueror seamonkey epiphany
;; known browsers ;; known browsers
camino skipstone camino skipstone
;; broken browsers (broken in that they won't work with plt-help) ;; broken browsers (broken in that they won't work with plt-help)
@ -51,14 +49,14 @@
;; by-need filtering of found unix executables ;; by-need filtering of found unix executables
(define existing-unix-browsers->exes (define existing-unix-browsers->exes
(delay (delay/sync
(filter values (filter values
(map (lambda (b) (map (lambda (b)
(let ([exe (find-executable-path (symbol->string b) #f)]) (let ([exe (find-executable-path (symbol->string b) #f)])
(and exe (cons b exe)))) (and exe (cons b exe))))
all-unix-browsers)))) all-unix-browsers))))
(define existing-unix-browsers (define existing-unix-browsers
(delay (map car (force existing-unix-browsers->exes)))) (delay/sync (map car (force existing-unix-browsers->exes))))
(define-syntax unix-browser-list (define-syntax unix-browser-list
(syntax-id-rules (set!) (syntax-id-rules (set!)
[(_ . xs) ((force existing-unix-browsers) . xs)] [(_ . xs) ((force existing-unix-browsers) . xs)]
@ -72,12 +70,12 @@
;; like (system-type), but return the real OS for OSX with XonX ;; like (system-type), but return the real OS for OSX with XonX
;; (could do the same for Cygwin, but it doesn't have shell-execute) ;; (could do the same for Cygwin, but it doesn't have shell-execute)
(define systype (define systype
(delay (let ([t (system-type)]) (delay/sync (let ([t (system-type)])
(cond [(not (eq? t 'unix)) t] (cond [(not (eq? t 'unix)) t]
[(regexp-match? #rx"-darwin($|/)" [(regexp-match? #rx"-darwin($|/)"
(path->string (system-library-subpath))) (path->string (system-library-subpath)))
'macosx] 'macosx]
[else t])))) [else t]))))
(define (%escape str) (define (%escape str)
(apply string-append (apply string-append
@ -157,7 +155,7 @@
(when delete-at (thread (lambda () (sleep delete-at) (delete-file temp)))) (when delete-at (thread (lambda () (sleep delete-at) (delete-file temp))))
(send-url/file temp))) (send-url/file temp)))
(define osascript (delay (find-executable-path "osascript" #f))) (define osascript (delay/sync (find-executable-path "osascript" #f)))
(define (send-url/mac url) (define (send-url/mac url)
(browser-run (force osascript) "-e" (format "open location \"~a\"" url))) (browser-run (force osascript) "-e" (format "open location \"~a\"" url)))
@ -196,7 +194,8 @@
;; finally, deal with the actual browser process ;; finally, deal with the actual browser process
[else [else
(case browser (case browser
[(gnome-open firefox konqueror dillo htmlview google-chrome) (simple)] [(xdg-open gnome-open firefox konqueror dillo htmlview google-chrome)
(simple)]
;; don't really know how to run these ;; don't really know how to run these
[(camino skipstone mosaic) (simple)] [(camino skipstone mosaic) (simple)]
[(galeon) (if (eq? 'browser-default separate-window?) [(galeon) (if (eq? 'browser-default separate-window?)