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

switch to scheme/base

Browse Source 
svn: r8441

original commit: 21ffab3fe3
This commit is contained in:
Eli Barzilay 2008-01-28 08:38:12 +00:00
parent 50108948b0
commit 88a4e688bf
1 changed files with 127 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/net/sendurl.ss
View File

@ -1,30 +1,31 @@
;; 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.)
(module sendurl mzscheme #lang scheme/base
(require (lib "process.ss")
(lib "file.ss")
(lib "kw.ss")
(lib "port.ss")
(lib "sendevent.ss"))
(provide send-url unix-browser-list browser-preference? external-browser) (require scheme/system
scheme/file
scheme/promise
scheme/port)
(define separate-by-default? (provide send-url unix-browser-list browser-preference? external-browser)
(define separate-by-default?
(get-preference 'new-browser-for-urls (lambda () #t))) (get-preference 'new-browser-for-urls (lambda () #t)))
(define unix-browser-list '(gnome-open firefox galeon opera netscape mozilla dillo)) (define unix-browser-list
'(gnome-open 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))))
;; : any -> bool ;; : any -> bool
(define (browser-preference? x) (define (browser-preference? x)
(or (not x) (eq? 'plt x) (memq x unix-browser-list) (custom-browser? x) (or (not x) (eq? 'plt x) (memq x unix-browser-list) (custom-browser? x)
(procedure? x))) (procedure? x)))
(define external-browser (define external-browser
(make-parameter (make-parameter
#f ; #f means "consult the preferences file" #f ; #f means "consult the preferences file"
(lambda (x) (lambda (x)
@ -32,9 +33,9 @@
x x
(error 'external-browser "~e is not a valid browser preference" x))))) (error 'external-browser "~e is not a valid browser preference" x)))))
;; 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 that it doesn't have shell-execute) ;; (could do the same for Cygwin, but that it doesn't have shell-execute)
(define systype (define systype
(delay (let ([t (system-type)]) (delay (let ([t (system-type)])
(cond [(not (eq? t 'unix)) t] (cond [(not (eq? t 'unix)) t]
[(regexp-match? #rx"-darwin($|/)" [(regexp-match? #rx"-darwin($|/)"
@ -42,9 +43,8 @@
'macosx] 'macosx]
[else t])))) [else t]))))
; send-url : str [bool] -> void ;; send-url : str [bool] -> void
(define/kw (send-url url-str (define (send-url url-str [separate-window? separate-by-default?])
#:optional [separate-window? separate-by-default?])
(define stupid-internal-define-syntax1 (define stupid-internal-define-syntax1
(unless (string? url-str) (unless (string? url-str)
(error 'send-url "expected a string, got ~e" url-str))) (error 'send-url "expected a string, got ~e" url-str)))
@ -96,8 +96,7 @@
=> (lambda (exe) => (lambda (exe)
(browser-process* exe (if separate-window? "-w" "-x") url-str))] (browser-process* exe (if separate-window? "-w" "-x") url-str))]
[(use-browser 'gnome-open) [(use-browser 'gnome-open)
=> (lambda (exe) => (lambda (exe) (browser-process* exe url-str))]
(browser-process* exe url-str))]
[(or (use-browser 'netscape) [(or (use-browser 'netscape)
(use-browser 'mozilla) (use-browser 'mozilla)
(use-browser 'firefox)) (use-browser 'firefox))
@ -121,8 +120,8 @@
(error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]) (error 'send-url "Couldn't find a browser to open URL: ~e" url-str)])
(void)) (void))
;; 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 values
(apply process*/ports (apply process*/ports
@ -135,8 +134,8 @@
(error 'run-browser "process execute failed: ~e" args)))) (error 'run-browser "process execute failed: ~e" args))))
(void))) (void)))
(define (browser-process* . args) (define (browser-process* . args)
(run-browser process*/ports args)) (run-browser process*/ports args))
(define (browser-process . args) (define (browser-process . args)
(run-browser process/ports args))) (run-browser process/ports args))