From 26e3651ef9a9f4b2527b9f42023faf9b790f123b Mon Sep 17 00:00:00 2001 From: Reuben Thomas Date: Tue, 12 Nov 2019 11:05:53 +0000 Subject: [PATCH] net-lib/net/sendurl.rkt: use same executable filtering on all systems MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Use “cmd.exe” on Windows. This enables us to have a list (of length one on macOS and Windows) of launcher executables on all platforms, and use send-url/unix, now renamed to send-url/simple, to launch all URLs without a query or fragment. --- pkgs/net-lib/net/sendurl.rkt | 93 ++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 41 deletions(-) diff --git a/pkgs/net-lib/net/sendurl.rkt b/pkgs/net-lib/net/sendurl.rkt index a35d875b64..f67665069a 100644 --- a/pkgs/net-lib/net/sendurl.rkt +++ b/pkgs/net-lib/net/sendurl.rkt @@ -7,7 +7,9 @@ racket/contract racket/promise json) (provide send-url send-url/file send-url/contents - unix-browser-list browser-preference? external-browser + browser-list external-browser + ;; Obsolete definitions + unix-browser-list browser-preference? (contract-out [send-url/mac (->* (string?) (#:browser string?) @@ -19,7 +21,7 @@ ;; 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 +(define all-browsers/unix '(;; general purpose launchers xdg-open ;; default browser launchers @@ -27,11 +29,44 @@ ;; common browsers firefox chromium-browser google-chrome opera seamonkey epiphany )) +(define all-browsers/win '(cmd.exe)) ; proxy for a basic functioning Windows system +(define all-browsers/mac '(open)) + +;; by-need filtering of found executables +(define existing-browsers->exes + (delay/sync + (filter values + (map (lambda (b) + (let ([exe (find-executable-path (symbol->string b) #f)]) + (and exe (cons b exe)))) + (case (system-type) + [(macosx) all-browsers/mac] + [(windows) all-browsers/win] + [(unix) all-browsers/unix] + [else (error 'send-url + "don't know how to open URL on platform: ~s" (system-type))]))))) + +(define existing-browsers + (delay/sync (map car (force existing-browsers->exes)))) +(define-syntax browser-list + (syntax-id-rules (set!) + [(_ . xs) ((force existing-browsers) . xs)] + [(set! _ . xs) (error 'browser-list "cannot be mutated")] + [_ (force existing-browsers)])) + + +;; Backwards compatibility + +(define unix-browser-list browser-list) ;; : any -> bool (define (custom-browser? x) (and (pair? x) (string? (car x)) (string? (cdr x)))) +;; : any -> bool +(define (browser-preference? x) + (or (not x) (memq x browser-list) (custom-browser? x) (procedure? x))) + (define external-browser (make-parameter #f ; #f means "consult the preferences file" @@ -40,25 +75,12 @@ x (error 'external-browser "~e is not a valid browser preference" x))))) -;; by-need filtering of found unix executables -(define existing-unix-browsers->exes - (delay/sync - (filter values - (map (lambda (b) - (let ([exe (find-executable-path (symbol->string b) #f)]) - (and exe (cons b exe)))) - all-unix-browsers)))) -(define existing-unix-browsers - (delay/sync (map car (force existing-unix-browsers->exes)))) -(define-syntax unix-browser-list - (syntax-id-rules (set!) - [(_ . xs) ((force existing-unix-browsers) . xs)] - [(set! _ . xs) (error 'unix-browser-list "cannot be mutated")] - [_ (force existing-unix-browsers)])) +(define (send-url/mac url #:browser [browser #f]) + (let ([browser-command (car browser-list)]) + (if browser + (browser-run browser-command "-a" browser url) + (browser-run browser-command url)))) -;; : any -> bool -(define (browser-preference? x) - (or (not x) (memq x unix-browser-list) (custom-browser? x) (procedure? x))) (define (%escape str) (apply string-append @@ -82,12 +104,7 @@ ((external-browser) url-str) (if (regexp-match? #rx"[#?]" url-str) (send-url/trampoline url-str separate-window?) - (case (system-type) - [(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))])))) + (send-url/simple url-str separate-window?)))) (void)) (define (send-url/file path [separate-window? separate-by-default?] @@ -140,30 +157,20 @@ (when delete-at (thread (lambda () (sleep delete-at) (delete-file temp)))) (send-url/file temp))) -(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 (send-url/win url) - (shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)) - -(define (send-url/unix url [separate-window? separate-by-default?]) +(define (send-url/simple 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) (if (symbol? pref) - (if (memq pref unix-browser-list) pref #f) + (if (memq pref browser-list) pref #f) pref)) (define browser (or (try (external-browser)) (try (get-preference 'external-browser)) ;; no preference -- chose the first one from the filtered list - (and (pair? unix-browser-list) (car unix-browser-list)))) + (and (pair? browser-list) (car browser-list)))) (define exe - (cond [(assq browser (force existing-unix-browsers->exes)) => cdr] + (cond [(assq browser (force existing-browsers->exes)) => cdr] [else #f])) (define (simple) (browser-run exe url)) (define (w/arg a) (browser-run exe a url)) @@ -171,6 +178,8 @@ (or (browser-run exe "-remote" (format "openURL(~a~a)" url (if separate-window? ",new-window" ""))) (simple))) + (define (windows-start) + (shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)) (cond [(not browser) (error 'send-url "Couldn't find a browser to open URL: ~e" url)] @@ -185,8 +194,10 @@ ;; finally, deal with the actual browser process [else (case browser - [(xdg-open sensible-browser x-www-browser firefox konqueror google-chrome chromium-browser) + [(open xdg-open + sensible-browser x-www-browser firefox konqueror google-chrome chromium-browser) (simple)] + [(cmd.exe) (windows-start)] ;; don't really know how to run these [(epiphany) (if separate-window? (w/arg "--new-window") (simple))] [(seamonkey opera) (try-remote)]