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
This commit is contained in:
Eli Barzilay 2007-05-10 17:45:21 +00:00
parent 83f2bdce62
commit f10c3c8acf
1 changed files with 40 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
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,66 +60,39 @@
(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) ;; opera may not return -- always open asyncronously
=> ;; opera starts a new browser automatically, if it can't find one
(lambda (exe) (browser-process* exe "-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?
(browser-process* exe "-remote" (format "~a,new-window" url-str)
(format "openURL(~a)" url-str))))]
(if separate-window? [(use-browser 'galeon)
(format "~a,new-window" url-str) => (lambda (exe)
url-str))))] (browser-process* exe (if separate-window? "-w" "-x") url-str))]
[(use-browser 'galeon preferred) [(or (use-browser 'netscape)
=> (use-browser 'mozilla))
(lambda (exe) => (lambda (exe)
(browser-process* exe (if separate-window? "-w" "-x") url-str))] ;; netscape's -remote returns with an error code, if no netscape is
[(or (use-browser 'netscape preferred) ;; around. start a new netscape in that case.
(use-browser 'mozilla preferred)) (or (system* exe "-remote"
=> (format "openURL(~a)"
(lambda (exe) (if separate-window?
;; netscape's -remote returns with an error code, if no (format "~a,new-window" url-str)
;; netscape is around. start a new netscape in that case. url-str)))
(or (system* exe "-remote" (browser-process* exe url-str)))]
(format "openURL(~a)" [(use-browser 'dillo)
(if separate-window? => (lambda (exe) (browser-process* exe url-str))]
(format "~a,new-window" url-str) [(custom-browser? preferred)
url-str))) (let ([cmd (string-append (car preferred)
(browser-process* exe url-str)))] url-str
[(use-browser 'dillo preferred) (cdr preferred))])
=> (browser-process cmd))]
(lambda (exe) (browser-process* exe url-str))]
[(custom-browser? preferred)
(let ([cmd (string-append (car preferred)
url-str
(cdr preferred))])
(browser-process cmd))]
[else
(error 'send-url "Couldn't find ~a to open URL: ~e"
(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 [else
(let loop ([l l]) (error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]))
(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)