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

better code layout, added firefox

Browse Source 
svn: r6190

original commit: f10c3c8acf
This commit is contained in:
Eli Barzilay 2007-05-10 17:45:21 +00:00
parent df196343cb
commit 3c2a10cc05
1 changed files with 40 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/net/sendurl.ss
View File

@ -10,6 +10,8 @@
(define separate-by-default? (define separate-by-default?
(get-preference 'new-browser-for-urls (lambda () #t))) (get-preference 'new-browser-for-urls (lambda () #t)))
(define unix-browser-list '(firefox galeon opera netscape mozilla dillo))
; : any -> bool ; : any -> bool
(define (custom-browser? x) (define (custom-browser? x)
(and (pair? x) (string? (car x)) (string? (cdr x)))) (and (pair? x) (string? (car x)) (string? (cdr x))))
@ -42,6 +44,12 @@
#:optional [separate-window? separate-by-default?]) #:optional [separate-window? separate-by-default?])
(define external (external-browser)) (define external (external-browser))
(define stype (force systype)) (define stype (force systype))
(define preferred '|? ? ?|)
(define (use-browser browser-name)
(when (eq? preferred '|? ? ?|)
(set! preferred (or external (get-preference 'external-browser))))
(and (or (not preferred) (eq? preferred browser-name))
(find-executable-path (symbol->string browser-name) #f)))
(cond (cond
[(procedure? external) (external url-str)] [(procedure? external) (external url-str)]
[(eq? stype 'macosx) [(eq? stype 'macosx)
@ -52,12 +60,9 @@
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)] (shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)]
[(not (eq? stype 'unix)) [(not (eq? stype 'unix))
(error 'send-url "don't know how to open URL on platform: ~s" stype)] (error 'send-url "don't know how to open URL on platform: ~s" stype)]
[else ; unix ;; unix
(let ([preferred (or external (get-preference 'external-browser))]) [(use-browser 'opera)
(cond => (lambda (exe)
[(use-browser 'opera preferred)
=>
(lambda (exe)
;; opera may not return -- always open asyncronously ;; opera may not return -- always open asyncronously
;; opera starts a new browser automatically, if it can't find one ;; opera starts a new browser automatically, if it can't find one
(browser-process* exe "-remote" (browser-process* exe "-remote"
@ -65,53 +70,29 @@
(if separate-window? (if separate-window?
(format "~a,new-window" url-str) (format "~a,new-window" url-str)
url-str))))] url-str))))]
[(use-browser 'galeon preferred) [(use-browser 'galeon)
=> => (lambda (exe)
(lambda (exe)
(browser-process* exe (if separate-window? "-w" "-x") url-str))] (browser-process* exe (if separate-window? "-w" "-x") url-str))]
[(or (use-browser 'netscape preferred) [(or (use-browser 'netscape)
(use-browser 'mozilla preferred)) (use-browser 'mozilla))
=> => (lambda (exe)
(lambda (exe) ;; netscape's -remote returns with an error code, if no netscape is
;; netscape's -remote returns with an error code, if no ;; around. start a new netscape in that case.
;; netscape is around. start a new netscape in that case.
(or (system* exe "-remote" (or (system* exe "-remote"
(format "openURL(~a)" (format "openURL(~a)"
(if separate-window? (if separate-window?
(format "~a,new-window" url-str) (format "~a,new-window" url-str)
url-str))) url-str)))
(browser-process* exe url-str)))] (browser-process* exe url-str)))]
[(use-browser 'dillo preferred) [(use-browser 'dillo)
=> => (lambda (exe) (browser-process* exe url-str))]
(lambda (exe) (browser-process* exe url-str))]
[(custom-browser? preferred) [(custom-browser? preferred)
(let ([cmd (string-append (car preferred) (let ([cmd (string-append (car preferred)
url-str url-str
(cdr preferred))]) (cdr preferred))])
(browser-process cmd))] (browser-process cmd))]
[else [else
(error 'send-url "Couldn't find ~a to open URL: ~e" (error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]))
(orify unix-browser-list) url-str)]))]))
(define unix-browser-list '(opera galeon netscape mozilla dillo))
; : (cons tst (listof tst)) -> str
(define (orify l)
(cond
[(null? (cdr l)) (format "~a" (car l))]
[(null? (cddr l)) (format "~a or ~a" (car l) (cadr l))]
[else
(let loop ([l l])
(cond
[(null? (cdr l)) (format "or ~a" (car l))]
[else (string-append (format "~a, " (car l)) (loop (cdr l)))]))]))
; : sym sym -> (U #f str)
; to find the path for the named browser, unless another browser is preferred
(define (use-browser browser-name preferred)
(and (or (not preferred)
(eq? preferred browser-name))
(find-executable-path (symbol->string browser-name) #f)))
;; 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)