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

reformatting etc

Browse Source 
svn: r6199
This commit is contained in:
Eli Barzilay 2007-05-11 05:47:00 +00:00
parent 091e7c0673
commit 09f09289e2
1 changed files with 209 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/browser/external.ss
View File

@ -16,8 +16,7 @@
; : -> bool
(define (unix-browser?)
(and (eq? (system-type) 'unix)
(not (equal? "ppc-darwin" (system-library-subpath)))))
(eq? (system-type) 'unix))
(fw:preferences:set-default
'external-browser
@ -41,14 +40,10 @@
(let* ([ops (current-proxy-servers)]
[removed (remove-all-proxies "http" ops)])
(current-proxy-servers
(if pref-val
(cons pref-val removed)
removed))))
(if pref-val (cons pref-val removed) removed))))
(define (remove-all-proxies scheme proxies)
(filter (lambda (x)
(and (pair? x)
(not (equal? (car x) scheme))))
(filter (lambda (x) (and (pair? x) (not (equal? (car x) scheme))))
proxies))
(fw:preferences:set-default http-proxy-preference #f proxy-pref?)
@ -155,12 +150,12 @@
(set! additions (append additions (list proc)))))
(define (make-help-browser-preference-panel set-help? ask-later? mk)
(mk
(lambda (parent)
(define callbacks null)
(let ([pref-panel (instantiate vertical-panel% ()
(parent parent) (alignment '(left center)))])
[parent parent]
[alignment '(left center)])])
;; -------------------- external browser for Unix --------------------
(when (unix-browser?)
@ -233,26 +228,25 @@
(refresh-controls (fw:preferences:get 'external-browser))
(set! callbacks
(cons
(fw:preferences:add-callback 'external-browser
(lambda (name browser)
(refresh-controls browser)))
(cons (fw:preferences:add-callback 'external-browser
(lambda (name browser) (refresh-controls browser)))
callbacks))
(let disable ([x raw:unix-browser-list] [n 0])
(cond
[(null? x) (void)]
[else (unless (find-executable-path (symbol->string (car x)) #f)
[else (unless (find-executable-path
(symbol->string (car x)) #f)
(send r enable n #f))
(disable (cdr x) (add1 n))]))))
;; -------------------- proxy for doc downloads --------------------
(when set-help?
(letrec ([p (instantiate group-box-panel% ()
(label (string-constant http-proxy))
(parent pref-panel)
(stretchable-height #f)
(alignment '(left top)))]
[label (string-constant http-proxy)]
[parent pref-panel]
[stretchable-height #f]
[alignment '(left top)])]
[rb (make-object radio-box%
#f (list (string-constant proxy-direct-connection)
(string-constant proxy-use-proxy))
@ -270,8 +264,8 @@
[update-proxy (lambda ()
(let ([host (send host get-value)]
[port (send port get-value)])
(let ([ok? (and (regexp-match "^[-0-9a-zA-Z.]+$" host)
(regexp-match "^[0-9]+$" port)
(let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host)
(regexp-match? #rx"^[0-9]+$" port)
(string->number port)
(<= 1 (string->number port) 65535))])
(when ok?
@ -282,7 +276,7 @@
[host (make-object text-field%
(string-constant proxy-host)
proxy-spec (lambda (x y) (update-proxy))
"www.someplacethatisaproxy.domain.comm")]
"www.someplacethatisaproxy.domain.com")]
[port (make-object text-field%
(string-constant proxy-port)
proxy-spec (lambda (x y) (update-proxy)) "65535")]