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

"fix" the windows problem, yet again

Browse Source 
svn: r8472
This commit is contained in:
Eli Barzilay 2008-01-30 02:51:46 +00:00
parent 989a163f3e
commit bc32b85ae4
1 changed files with 43 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
collects/net/sendurl.ss
View File

@ -170,63 +170,51 @@
url (if separate-window? ",new-window" "")))] url (if separate-window? ",new-window" "")))]
[else (error 'send-url "internal error")])])) [else (error 'send-url "internal error")])]))
;; Windows -- IE7 has a bug: when launched (either through shell-execute or ;; Windows has a bug when using `shell-execute' or when running `iexplore.exe'
;; directly) it will ignore the fragment for `file:' URLs. A workaround that ;; directly -- it silently drops the fragment and query from URLs that have
;; seems to work is to run `explorer.exe' instead. The problem is described at ;; them. This is described at
;; http://support.microsoft.com/default.aspx/kb/942172, and when a fix will be ;; http://support.microsoft.com/default.aspx/kb/942172
;; released (and enough time to be widely used), this whole thing should go ;; It seems that the IE7 problem happens either way (`shell-execute' or running
;; away and the simple `shell-eexcute' will work fine. (See also ;; directly) -- but it also happens with firefox when using `shell-execute'.
;; http://www.tutorials-win.com/IE/Lauching-HTML/) ;; The current solution is to run `ftype http' to find the default browser
;; command, if it uses `iexplore.exe', then change it to `explorer.exe', and
;; run the resulting command directly. This is described at
;; http://www.tutorials-win.com/IE/Lauching-HTML/
;; Hopefully this works. One question is whether IE6 will still work fine;
;; another is other browsers work; and finally, we need to parse the command
;; and substitute the url for `%1' (if it appears). If there are other `%'s,
;; throw an error so we can hack that in too.
;; Oh and it seems that there is no way to get this to work on Vista, the above
;; MS page says that the problem is that IE will start a more priviliged one,
;; handing over the URL -- which, again, gets the fragment+query stripped
;; away...
(define (using-ie7?) (define windows-http-command
(define (bytes0 bs) (delay (let ([out (open-output-string)])
(list->bytes (apply append (map (lambda (b) (list b 0)) (bytes->list bs))))) (parameterize ([current-output-port out]
(define (run cmd) [current-input-port (open-input-string "")]
(define out (open-output-string)) [current-error-port (open-output-nowhere)])
(parameterize ([current-output-port out] (and (system "ftype http")
[current-input-port (open-input-string "")] (cond [(regexp-match #rx"(?:^|\r?\n)?http=([^\r\n]+)\r?\n"
[current-error-port (open-output-nowhere)]) (get-output-string out))
;; just return #f on errors, since we can still use => cadr]
;; shell-execute in this case -- better a dropped anchor than no [else #f]))))))
;; help at all
(and (system cmd) (get-output-string out))))
(define (get-regdata)
(define regfile (make-temporary-file "registry-data-~a"))
(dynamic-wind
void
(lambda ()
(and (run (format "regedit /e \"~a\" \"~a\""
regfile
(regexp-replace* #rx"/" keypath "\\\\")))
(let ([n (file-size regfile)])
(with-input-from-file regfile (lambda () (read-bytes n))))))
(lambda () (delete-file regfile))))
(define keypath
"HKEY_LOCAL_MACHINE/Software/Microsoft/Internet Explorer/Version Vector")
(define version-rx
(bytes-append (bytes0 #"\r\n\"IE\"=\"") #"([0-9.\0]+)" (bytes0 #"\"\r\n")))
(and
;; Is IE the default browser?
(cond [(run "ftype http")
=> (lambda (s)
(regexp-match? #px"^(?i:http=\"(.*\\\\|)iexplore.exe\")" s))]
[else #f])
;; Get the registry data and check the version. We could convert the UTF-16
;; result to UTF-8, but we're looking for a simple pattern, so just search
;; for the expected UTF-16 sequence directly.
(cond [(regexp-match version-rx (get-regdata))
=> (lambda (m) (regexp-match? #rx#"^7\0\\.\0" (cadr m)))]
[else #f])))
(define send-url/win-proc (define (send-url/win url)
(delay (let ([explorer (and (using-ie7?) (find-exe "explorer.exe"))]) (let ([cmd (force windows-http-command)])
(if explorer (browser-run
;; looks like explorer.exe always returns an error code #:shell #t #:ignore-exit-code #t
(lambda (url) (browser-run #:ignore-exit-code #t explorer url)) (cond [(and (or (not cmd)
(lambda (url) (regexp-match? #px"(?:^|[/\\\\])(?i:iexplore.exe)" cmd))
(shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)))))) ;; IE: try to find exeplorer instead
(find-exe "explorer.exe"))
(define (send-url/win url) ((force send-url/win-proc) url)) => (lambda (exe) (format "\"~a\" ~a" exe url))]
[(not (regexp-match? #rx"%" cmd))
(format "~a ~a" cmd url)]
[(regexp-match? #rx"%[^1]" cmd)
(error 'send-url/win "Unknown browser configuration: ~s\n~a"
cmd "*** Please report this as a bug!")]
[else (regexp-replace* #rx"%1" cmd url)]))))
;; Process helper ;; Process helper
(define (browser-run #:shell [shell? #f] #:ignore-exit-code [nowait? #f] . args) (define (browser-run #:shell [shell? #f] #:ignore-exit-code [nowait? #f] . args)