diff --git a/pkgs/net-doc/net/scribblings/sendurl.scrbl b/pkgs/net-doc/net/scribblings/sendurl.scrbl
index 8b29ca792d..48e1a66109 100644
--- a/pkgs/net-doc/net/scribblings/sendurl.scrbl
+++ b/pkgs/net-doc/net/scribblings/sendurl.scrbl
@@ -20,16 +20,8 @@ manner. For some platforms and configurations, the
@racket[separate-window?] parameter determines if the browser creates
a new window to display the URL or not.
-On Windows, @racket[send-url] normally uses @racket[shell-execute]
-to launch a browser. (If the URL appears to contain a fragment, it may
-use an intermediate redirecting file due to a bug in IE7.)
-
On Mac OS, @racket[send-url] calls @racket[send-url/mac].
-On Unix, @racket[send-url] uses a user-preference, or when none is
-set, it will look for a known browser. See the description of
-@racket[external-browser] for details.
-
If @racket[escape?] is true, then @racket[str] is escaped (by UTF-8
encoding followed by ``%'' encoding) to avoid dangerous shell
characters: single quotes, double quotes, backquotes, dollar signs,
@@ -37,7 +29,7 @@ backslashes, non-ASCII characters, and non-graphic characters. Note
that escaping does not affect already-encoded characters in
@racket[str].
-On all platforms, @racket[external-browser] parameter can be set to a
+On all platforms, the @racket[external-browser] parameter can be set to a
procedure to override the above behavior --- the procedure will be
called with the @racket[url] string.}
@@ -83,20 +75,9 @@ above.}
The optional @racket[browser] argument, if present, should be the name
of a browser installed on the system. For example,
- @racketblock[(send-url/mac "http://www.google.com/" #:browser "Firefox")]
+ @racketblock[(send-url/mac "https://www.google.com/" #:browser "Firefox")]
would open the url in Firefox, even if that's not the default browser.
Passing @racket[#f] means to use the default browser.
-
- This function looks in
- @filepath{com.apple.launchservices.secure.plist} in the
- user's home directory for a @tt{LSHandlerURLScheme} key for
- either @tt{http} or @tt{https} and then, looks for a
- @tt{LSHandlerRoleAll} key that is one of a list of known
- browsers. If it finds such a browser, it uses the
- AppleScript command @tt{tell
- application ... to open location} to send the url to the
- browser. Otherwise, it uses just @tt{open location} to send
- the url to the browser.
}
@defparam[external-browser cmd browser-preference?]{
@@ -104,16 +85,16 @@ above.}
A parameter that can hold a procedure to override how a browser is
started, or @racket[#f] to use the default platform-dependent command.
-On Unix, the command that is used depends on the
-@racket['external-browser] preference. If the preference is unset,
-@racket[send-url] uses the first of the browsers from
-@racket[unix-browser-list] for which the executable is found.
-Otherwise, the preference should hold a symbol indicating a known
-browser (from the @racket[unix-browser-list]), or it a pair of a prefix
-and a suffix string that are concatenated around the @racket[url] string
-to make up a shell command to run. In addition, the
-@racket[external-browser] paremeter can be set to one of these values,
-and @racket[send-url] will use it instead of the preference value.
+On Unix, the command that is used depends on the @racket['external-browser]
+preference. It's recommended not to use this preference, but to rely on
+@tt{xdg-open}. If the preference is unset, @racket[send-url] uses the first
+of the browsers from @racket[unix-browser-list] for which the executable is
+found. Otherwise, the preference should hold a symbol indicating a known
+browser (from the @racket[unix-browser-list]), or it a pair of a prefix and
+a suffix string that are concatenated around the @racket[url] string to make
+up a shell command to run. In addition, the @racket[external-browser]
+paremeter can be set to one of these values, and @racket[send-url] will use
+it instead of the preference value.
Note that the URL is encoded to make it work inside shell double-quotes:
URLs can still hold characters like @litchar{#}, @litchar{?}, and
@@ -136,4 +117,3 @@ A list of symbols representing Unix executable names that may be tried
in order by @racket[send-url]. The @racket[send-url] function
internally includes information on how to launch each executable with
a URL.}
-
diff --git a/pkgs/net-lib/net/sendurl.rkt b/pkgs/net-lib/net/sendurl.rkt
index 3fed5e0397..07c5ce597c 100644
--- a/pkgs/net-lib/net/sendurl.rkt
+++ b/pkgs/net-lib/net/sendurl.rkt
@@ -14,26 +14,18 @@
#:pre (equal? (system-type) 'macosx)
void?)]))
-(define separate-by-default?
- ;; internal configuration, 'browser-default lets some browsers decide
- (delay (get-preference 'new-browser-for-urls
- (lambda () 'browser-default)
- #:timeout-lock-there (lambda (path) 'browser-default))))
+;; Will we open a new browser window (where possible) by default?
+(define separate-by-default? #t)
;; all possible unix browsers, filtered later to just existing executables
;; order matters: the default will be the first of these that is found
(define all-unix-browsers
- '(;; default browser launchers
+ '(;; general purpose launchers
+ xdg-open
+ ;; default browser launchers
sensible-browser x-www-browser
;; common browsers
- firefox chromium-browser google-chrome galeon opera mozilla konqueror seamonkey epiphany
- ;; known browsers
- camino skipstone
- ;; broken browsers (broken in that they won't work with plt-help)
- ;; this is a configurable thing that is deprecated
- htmlview
- ;; dillo does not have javascript
- dillo
+ firefox chromium-browser google-chrome opera seamonkey epiphany
))
;; : any -> bool
@@ -68,6 +60,9 @@
(define (browser-preference? x)
(or (not x) (memq x unix-browser-list) (custom-browser? x) (procedure? x)))
+(define (url-contains-query-or-fragment url)
+ (regexp-match? #rx"[#?]" url))
+
(define (%escape str)
(apply string-append
(map (lambda (b)
@@ -89,9 +84,9 @@
(if (procedure? (external-browser))
((external-browser) url-str)
(case (system-type)
- ['macosx (send-url/mac url-str)]
- ['windows (send-url/win url-str)]
- ['unix (send-url/unix url-str (force separate-window?))]
+ [(macosx) (send-url/mac url-str)]
+ [(windows) (send-url/win url-str)]
+ [(unix) (send-url/unix url-str separate-window?)]
[else (error 'send-url
"don't know how to open URL on platform: ~s" (system-type))])))
(void))
@@ -115,7 +110,7 @@
[path (if query (string-append path "?" (escape-url query)) path)]
[path (if fragment (string-append path "#" (escape-url fragment))
path)])
- (send-url path (force separate-window?) #:escape? #f)))
+ (send-url path separate-window? #:escape? #f)))
;; See the documentation for the `delete-at' argument
;; separate-window? is never used
@@ -146,72 +141,14 @@
(when delete-at (thread (lambda () (sleep delete-at) (delete-file temp))))
(send-url/file temp)))
-(define osascript (delay/sync (find-executable-path "osascript" #f)))
-(define (send-url/mac url #:browser [_browser #f])
- (define browser
- (or _browser
- (try-to-find-macosx-users-browser)))
- (browser-run (force osascript) "-e"
- (if browser
- (format "tell application \"~a\" to open location \"~a\" activate"
- browser url)
- (format "open location \"~a\"" url))))
+(define open-program (delay/sync (find-executable-path "open" #f)))
+(define (send-url/mac url #:browser [browser #f])
+ (let ([browser-command (force open-program)])
+ (if browser
+ (browser-run browser-command "-a" browser url)
+ (browser-run browser-command url))))
-(define (try-to-find-macosx-users-browser)
- (define default-browser (hash-ref known-uri->macosx-browser-app "com.apple.safari"))
- (let/ec k
- (define (fail fmt . more)
- (log-warning (string-append
- "tried to find user's browser choice, but: "
- (apply format fmt more)))
- (k default-browser))
- (define plist-file
- (build-path (find-system-path 'home-dir)
- "Library" "Preferences"
- "com.apple.LaunchServices"
- "com.apple.launchservices.secure.plist"))
- (unless (file-exists? plist-file) (fail "didn't find plist file"))
- (define plutil (find-executable-path "plutil" #f))
- (unless plutil (fail "didn't find plutil"))
- (define-values (in out) (make-pipe))
- (thread
- (λ ()
- (define-values (_1 _2 _3 _4 proc)
- (apply
- values
- (process*/ports
- out
- (open-input-string "")
- (current-error-port)
- plutil
- "-convert" "json"
- "-o" "-"
- plist-file)))
- (proc 'wait)
- (close-output-port out)))
- (define json
- (with-handlers ([exn:fail? (λ (exn) (fail (exn-message exn)))])
- (read-json in)))
- (define handlers (hash-ref json 'LSHandlers (λ () (fail "didn't find LSHandlers key in json"))))
- (unless ((listof hash?) handlers) (fail "confusing LSHandlers ~s" handlers))
- (define uri
- (for/or ([table (in-list (hash-ref json 'LSHandlers))]
- #:when
- (member (hash-ref table 'LSHandlerURLScheme #f) '("http" "https")))
- (hash-ref table 'LSHandlerRoleAll #f)))
- (cond
- [uri (hash-ref known-uri->macosx-browser-app uri #f)]
- [else
- ;; no preference set
- default-browser])))
-
-(define known-uri->macosx-browser-app
- (hash "com.google.chrome" "Google Chrome"
- "com.apple.safari" "Safari"
- "org.mozilla.firefox" "Firefox"
- "com.operasoftware.opera" "Opera"))
-
-(define (send-url/unix url separate-window?)
+(define (send-url/unix url [separate-window? separate-by-default?])
;; in cases where a browser was uninstalled, we might get a preference that
;; is no longer valid, this will turn it back to #f
(define (try pref)
@@ -228,9 +165,13 @@
[else #f]))
(define (simple) (browser-run exe url))
(define (w/arg a) (browser-run exe a url))
+ (define (trampoline)
+ (if (url-contains-query-or-fragment url)
+ (send-url/trampoline url separate-window?)
+ (browser-run exe url)))
(define (try-remote)
- (or (system* exe "-remote" (format "openURL(~a~a)" url
- (if separate-window? ",new-window" "")))
+ (or (browser-run exe "-remote" (format "openURL(~a~a)" url
+ (if separate-window? ",new-window" "")))
(simple)))
(cond
[(not browser)
@@ -246,48 +187,35 @@
;; finally, deal with the actual browser process
[else
(case browser
- [(sensible-browser x-www-browser firefox konqueror dillo htmlview google-chrome chromium-browser)
+ [(xdg-open) (trampoline)]
+ [(sensible-browser x-www-browser firefox konqueror google-chrome chromium-browser)
(simple)]
;; don't really know how to run these
- [(camino skipstone) (simple)]
- [(galeon) (if (eq? 'browser-default separate-window?)
- (simple) (w/arg (if separate-window? "-w" "-x")))]
[(epiphany) (if separate-window? (w/arg "--new-window") (simple))]
- [(mozilla seamonkey) (try-remote)]
- [(opera)
- ;; opera starts a new browser automatically
- (browser-run exe "-remote"
- (format "openURL(~a~a)"
- url (if separate-window? ",new-window" "")))]
+ [(seamonkey opera) (try-remote)]
[else (error 'send-url "internal error")])]))
-;; Windows has a bug when using `shell-execute' or when running `iexplore.exe'
-;; directly -- it silently drops the fragment and query from URLs that have
-;; them. This is described at
-;; http://support.microsoft.com/default.aspx/kb/942172
-;; It seems that the IE7 problem happens either way (`shell-execute' or running
-;; directly) -- but it also happens with firefox when using `shell-execute'.
-;; One possible solution is to run `ftype http' to find the default browser
-;; command, and 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/
-;; But this still fails on Vista, since the problem there is that launching a
-;; browser with a file:// URL makes it start a more priviliged process, and
-;; doing that drops the fragment again. So the solution that the code below
-;; implements is to write and use (via `send-url/contents') a trampoline html
-;; that redirects to the actual file and fragment.
-
+;; Windows can directly launch URLs, but silently drops the fragment and
+;; query from file URLs that have them, so use send-url/trampoline in that
+;; case.
(define (send-url/win url)
- (if (not (regexp-match? #rx"[#?]" url))
- (shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)
- (send-url/contents
- (string-append
- ""
- "Please go here.")
- ;; starting the browser may take a while, don't remove the file
- ;; immediately (this means that when used via plt-help, these files are
- ;; never removed by a timer)
- #:delete-at 15)))
+ (if (not (url-contains-query-or-fragment url))
+ (shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)
+ (send-url/trampoline url)))
+
+;; Write and use (via `send-url/contents') a trampoline html that redirects
+;; to the actual file and fragment, for launchers that can't cope with query
+;; and fragment part of the URL.
+(define (send-url/trampoline url [separate-window? separate-by-default?])
+ (send-url/contents
+ (string-append
+ ""
+ "Please go here.")
+ separate-window?
+ ;; starting the browser may take a while, don't remove the file
+ ;; immediately (this means that when used via plt-help, these files are
+ ;; never removed by a timer)
+ #:delete-at 15))
;; Process helper
(define (browser-run #:shell [shell? #f] . args)