From f28170505472c0ce875d0e6993c887d4642b5b09 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 13 Dec 2007 17:20:01 +0000 Subject: [PATCH] try to make send-url work with URLS containing fragments under Windows svn: r7993 --- collects/net/sendurl.ss | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/collects/net/sendurl.ss b/collects/net/sendurl.ss index 90efd37b81..647a888409 100644 --- a/collects/net/sendurl.ss +++ b/collects/net/sendurl.ss @@ -61,7 +61,25 @@ [(eq? stype 'macosx) (browser-process (format "osascript -e 'open location \"~a\"'" url-str))] [(eq? stype 'windows) - (shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL)] + (let ([simple + (lambda () + (shell-execute #f url-str "" (current-directory) 'SW_SHOWNORMAL))]) + (if (regexp-match #rx"#" url-str) + ;; complex case: need to launch the browser directly, + ;; otherwise the fragment is ignored. Use `ftype' to discover + ;; the browser... + (let ([p (process "ftype htmlfile")]) + (close-output-port (cadr p)) + (let ([s (read-line (car p) 'return-linefeed)]) + (close-input-port (car p)) + (close-input-port (cadddr p)) + (let ([m (regexp-match #rx"^htmlfile=(.*)" s)]) + (if m + (browser-process (string-append (cadr m) " " url-str)) + ;; give up and use simple mode + (simple))))) + ;; simple case: no fragment + (simple)))] [(not (eq? stype 'unix)) (error 'send-url "don't know how to open URL on platform: ~s" stype)] ;; unix