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
;; (others just use the (send-url url [new?]) interface.)
(module sendurl mzscheme
(require (lib "process.ss")
(lib "file.ss")
(lib "kw.ss")
(lib "port.ss")
(lib "sendevent.ss"))
#lang scheme/base
(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)))
(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
(define (custom-browser? x)
;; : any -> bool
(define (custom-browser? x)
(and (pair? x) (string? (car x)) (string? (cdr x))))
;; : any -> bool
(define (browser-preference? x)
;; : any -> bool
(define (browser-preference? x)
(or (not x) (eq? 'plt x) (memq x unix-browser-list) (custom-browser? x)
(procedure? x)))
(define external-browser
(define external-browser
(make-parameter
#f ; #f means "consult the preferences file"
(lambda (x)
@ -32,9 +33,9 @@
x
(error 'external-browser "~e is not a valid browser preference" x)))))
;; 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)
(define systype
;; 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)
(define systype
(delay (let ([t (system-type)])
(cond [(not (eq? t 'unix)) t]
[(regexp-match? #rx"-darwin($|/)"
@ -42,9 +43,8 @@
'macosx]
[else t]))))
; send-url : str [bool] -> void
(define/kw (send-url url-str
#:optional [separate-window? separate-by-default?])
;; send-url : str [bool] -> void
(define (send-url url-str [separate-window? separate-by-default?])
(define stupid-internal-define-syntax1
(unless (string? url-str)
(error 'send-url "expected a string, got ~e" url-str)))
@ -96,8 +96,7 @@
=> (lambda (exe)
(browser-process* exe (if separate-window? "-w" "-x") url-str))]
[(use-browser 'gnome-open)
=> (lambda (exe)
(browser-process* exe url-str))]
=> (lambda (exe) (browser-process* exe url-str))]
[(or (use-browser 'netscape)
(use-browser 'mozilla)
(use-browser 'firefox))
@ -121,8 +120,8 @@
(error 'send-url "Couldn't find a browser to open URL: ~e" url-str)])
(void))
;; run-browser : process-proc list-of-strings -> void
(define (run-browser process*/ports args)
;; run-browser : process-proc list-of-strings -> void
(define (run-browser process*/ports args)
(let-values ([(stdout stdin pid stderr control)
(apply values
(apply process*/ports
@ -135,8 +134,8 @@
(error 'run-browser "process execute failed: ~e" args))))
(void)))
(define (browser-process* . args)
(define (browser-process* . args)
(run-browser process*/ports args))
(define (browser-process . args)
(run-browser process/ports args)))
(define (browser-process . args)
(run-browser process/ports args))