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

more reformatting, fix bug (library-subpath is a path)

Browse Source 
svn: r5722
This commit is contained in:
Eli Barzilay 2007-03-03 08:47:33 +00:00
parent 625db9b469
commit ec7d6f88fd
1 changed files with 73 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
collects/net/sendurl.ss
View File

@ -27,13 +27,66 @@
x x
(error 'external-browser "~a is not a valid browser preference" x))))) (error 'external-browser "~a is not a valid browser preference" x)))))
(define osx-browser?
(delay (or (eq? (system-type) 'macosx)
(equal? "ppc-darwin" (path->string (system-library-subpath))))))
; send-url : str [bool] -> void ; send-url : str [bool] -> void
(define/kw (send-url url-str (define/kw (send-url url-str
#:optional [separate-window? separate-by-default?]) #:optional [separate-window? separate-by-default?])
(define external (external-browser))
(define stype (system-type))
(cond (cond
[(procedure? (external-browser)) [(procedure? external) (external url-str)]
((external-browser) url-str)] [(force osx-browser?)
[(eq? (system-type) 'macos) ;; not sure what changed, but this is wrong now.... -robby
;; (browser-process (format "osascript -e 'open location \"~a\"'"
;; (regexp-replace* "%" url-str "%25")))
(browser-process (format "osascript -e 'open location \"~a\"'" url-str))]
[(eq? stype 'windows)
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)]
[(eq? stype 'unix)
(let ([preferred (or external (get-preference 'external-browser))])
(cond
[(use-browser 'opera preferred)
=>
(lambda (exe)
;; opera may not return -- always open asyncronously
;; opera starts a new browser automatically, if it can't find one
(browser-process* exe "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" url-str)
url-str))))]
[(use-browser 'galeon preferred)
=>
(lambda (exe)
(browser-process* exe (if separate-window? "-w" "-x") url-str))]
[(or (use-browser 'netscape preferred)
(use-browser 'mozilla preferred))
=>
(lambda (exe)
;; netscape's -remote returns with an error code, if no
;; netscape is around. start a new netscape in that case.
(or (system* exe "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" url-str)
url-str)))
(browser-process* exe url-str)))]
[(use-browser 'dillo preferred)
=>
(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)]))]
#; ; macos is dead -- this code should be removed if nobody shouts
[(eq? stype 'macos)
(if (regexp-match "Blue Box" (system-type 'machine)) (if (regexp-match "Blue Box" (system-type 'machine))
;; Classic inside OS X: ;; Classic inside OS X:
(let loop ([l '("MSIE" "NAVG")]) (let loop ([l '("MSIE" "NAVG")])
@ -44,66 +97,19 @@
(let loop ([retries 2]) ;; <<< Yuck <<< (let loop ([retries 2]) ;; <<< Yuck <<<
(if (zero? retries) (if (zero? retries)
(error "enough already") ; caught above (error "enough already") ; caught above
(with-handlers ([exn:fail? (lambda (x) (with-handlers ([exn:fail?
(loop (sub1 retries)))]) (lambda (x) (loop (sub1 retries)))])
(let ([t (thread (lambda () (let ([t (thread
(send-event (car l) "GURL" "GURL" url-str)))]) (lambda ()
(send-event (car l) "GURL" "GURL" url-str)))])
(sync/timeout 1 t) ;; <<< Yuck (timeout) <<< (sync/timeout 1 t) ;; <<< Yuck (timeout) <<<
(when (thread-running? t) (when (thread-running? t)
(kill-thread t) (kill-thread t)
(error "timeout"))))))))) (error "timeout")))))))))
;; Normal OS Classic: ;; Normal OS Classic:
(send-event "MACS" "GURL" "GURL" url-str))] (send-event "MACS" "GURL" "GURL" url-str))]
[(or (eq? (system-type) 'macosx) [else (error 'send-url
(equal? "ppc-darwin" (system-library-subpath))) "don't know how to open URL on platform: ~s" stype)]))
;; not sure what changed, but this is wrong now.... -robby
;;(browser-process (format "osascript -e 'open location \"~a\"'" (regexp-replace* "%" url-str "%25")))
(browser-process (format "osascript -e 'open location \"~a\"'" url-str))]
[(eq? (system-type) 'windows)
(shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)]
[(eq? (system-type) 'unix)
(let ([preferred (or (external-browser) (get-preference 'external-browser))])
(cond
[(use-browser 'opera preferred)
=>
(lambda (browser-path)
;; opera may not return -- always open asyncronously
;; opera starts a new browser automatically, if it can't find one
(browser-process* browser-path "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" url-str)
url-str))))]
[(use-browser 'galeon preferred)
=>
(lambda (browser-path)
(browser-process* browser-path
(if separate-window? "-w" "-x")
url-str))]
[(or (use-browser 'netscape preferred)
(use-browser 'mozilla preferred))
=>
(lambda (browser-path)
;; netscape's -remote returns with an error code, if no
;; netscape is around. start a new netscape in that case.
(or (system* browser-path "-remote"
(format "openURL(~a)"
(if separate-window?
(format "~a,new-window" url-str)
url-str)))
(browser-process* browser-path url-str)))]
[(use-browser 'dillo preferred)
=>
(lambda (browser-path)
(browser-process* browser-path 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)]))]
[else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))]))
(define unix-browser-list '(opera galeon netscape mozilla dillo)) (define unix-browser-list '(opera galeon netscape mozilla dillo))
@ -113,10 +119,10 @@
[(null? (cdr l)) (format "~a" (car l))] [(null? (cdr l)) (format "~a" (car l))]
[(null? (cddr l)) (format "~a or ~a" (car l) (cadr l))] [(null? (cddr l)) (format "~a or ~a" (car l) (cadr l))]
[else [else
(let loop ([l l]) (let loop ([l l])
(cond (cond
[(null? (cdr l)) (format "or ~a" (car l))] [(null? (cdr l)) (format "or ~a" (car l))]
[else (string-append (format "~a, " (car l)) (loop (cdr l)))]))])) [else (string-append (format "~a, " (car l)) (loop (cdr l)))]))]))
; : sym sym -> (U #f str) ; : sym sym -> (U #f str)
; to find the path for the named browser, unless another browser is preferred ; to find the path for the named browser, unless another browser is preferred
@ -128,11 +134,10 @@
;; 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)
(let-values ([(stdout stdin pid stderr control) (let-values ([(stdout stdin pid stderr control)
(apply values (apply process*/ports (apply values
(open-output-nowhere) (apply process*/ports
#f (open-output-nowhere) #f (current-error-port)
(current-error-port) args))])
args))])
(close-output-port stdin) (close-output-port stdin)
(thread (lambda () (thread (lambda ()
(control 'wait) (control 'wait)
@ -143,5 +148,5 @@
(define (browser-process* . args) (define (browser-process* . args)
(run-browser process*/ports args)) (run-browser process*/ports args))
(define (browser-process cmd) (define (browser-process . args)
(run-browser process/ports (list cmd)))) (run-browser process/ports args)))