From ae621ddd83662ed2ad51b311c0e7063e3ac8f235 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 4 Mar 2002 18:10:53 +0000
Subject: [PATCH] ..

original commit: 5326de1baf4601f4a8b9260ce80b24707e4a62d8
---
 collects/net/sendurl.ss | 105 ++++++++++++++++++++++------------------
 1 file changed, 57 insertions(+), 48 deletions(-)

diff --git a/collects/net/sendurl.ss b/collects/net/sendurl.ss
index 99a8ab9d3b..169097e4fe 100644
--- a/collects/net/sendurl.ss
+++ b/collects/net/sendurl.ss
@@ -1,58 +1,67 @@
 
 (module sendurl mzscheme
   (require (lib "process.ss")
-	   (lib "file.ss"))
+	   (lib "file.ss")
+	   (lib "etc.ss"))
   
   (provide send-url)
   
   ; send-url : str -> void
-  (define (send-url str)
-    (parameterize ([current-input-port null-input]
-                   [current-error-port null-output] ; comment out this line to see error messages
-                   [current-output-port null-output])
-      (case (system-type)
-        [(macos macosx)
-         ;; actually, I think GURL means something slightly different...
-         (send-event "MACS" "GURL" "GURL" str)]
-        [(windows)
-         ;; Try to get a MrEd function...
-         (let ([get-res (with-handlers ([not-break-exn? (lambda (x) #f)])
-                          (dynamic-require '(lib "mred.ss" "mred") 'get-resource))])
-           (if get-res
-               (let ([b (box "")])
-                 (unless (get-res "HKEY_CLASSES_ROOT" "htmlfile\\shell\\open\\command" b)
-                   (error 'send-url "couldn't find URL opener in the registry"))
-                 (let-values ([(out in id err status) (apply 
-                                                       values
-                                                       (process (format "~a ~a" (unbox b) str)))])
-                   (close-output-port in)
-                   (close-input-port out)
-                   (close-input-port err)))
-               (error 'send-url "don't know how to open URL in Windows without MrEd")))]
-        [(unix)
-         (let ([preferred (get-preference 'external-browser (lambda () #f))])
-           (cond
-             [(and (or (not preferred)
-                       (eq? preferred 'opera))
-                   (find-executable-path "opera" #f))
-              =>
-              (lambda (browser-path) 
-                ;; opera may not return -- always open asyncronously
-                ;; opera starts a new browser automatically, if it can't find one
-                ;; We no longer pass ,new-window since the teachpack always calls send-url now.
-                (process*/close-ports browser-path "-remote" (format "openURL(~a)" str)))]
-             [(and (and (or (not preferred)
-                            (eq? preferred 'netscape)))
-                   (find-executable-path "netscape" #f))
-              =>
-              (lambda (browser-path)
-                ;; netscape's -remote returns with an error code, if no
-                ;; netscape is around. start a new netscape in that case.
-                (or (system* browser-path "-remote" (format "openURL(~a)" str))
-                    (process*/close-ports browser-path str)))]
-             [else
-              (error 'open-url "Couldn't find Netscape or Opera to open URL: ~e" str)]))]
-        [else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))])))
+  (define send-url
+    (opt-lambda (str [separate-window? #t])
+      (parameterize ([current-input-port null-input]
+		     [current-error-port null-output] ; comment out this line to see error messages
+		     [current-output-port null-output])
+	(case (system-type)
+	  [(macos macosx)
+	   ;; actually, I think GURL means something slightly different...
+	   (send-event "MACS" "GURL" "GURL" str)]
+	  [(windows)
+	   ;; Try to get a MrEd function...
+	   (let ([get-res (with-handlers ([not-break-exn? (lambda (x) #f)])
+			    (dynamic-require '(lib "mred.ss" "mred") 'get-resource))])
+	     (if get-res
+		 (let ([b (box "")])
+		   (unless (get-res "HKEY_CLASSES_ROOT" "htmlfile\\shell\\open\\command" b)
+		     (error 'send-url "couldn't find URL opener in the registry"))
+		   (let-values ([(out in id err status) (apply 
+							 values
+							 (process (format "~a ~a" (unbox b) str)))])
+		     (close-output-port in)
+		     (close-input-port out)
+		     (close-input-port err)))
+		 (error 'send-url "don't know how to open URL in Windows without MrEd")))]
+	  [(unix)
+	   (let ([preferred (get-preference 'external-browser (lambda () #f))])
+	     (cond
+	       [(and (or (not preferred)
+			 (eq? preferred 'opera))
+		     (find-executable-path "opera" #f))
+		=>
+		(lambda (browser-path) 
+		  ;; opera may not return -- always open asyncronously
+		  ;; opera starts a new browser automatically, if it can't find one
+		  (process*/close-ports browser-path "-remote"
+					(format "openURL(~a)"
+						(if separate-window?
+						    (format "~a,new-window" str)
+						    str))))]
+	       [(and (and (or (not preferred)
+			      (eq? preferred 'netscape)))
+		     (find-executable-path "netscape" #f))
+		=>
+		(lambda (browser-path)
+		  ;; netscape's -remote returns with an error code, if no
+		  ;; netscape is around. start a new netscape in that case.
+		  (or (system* browser-path "-remote"
+			       (format "openURL(~a)"
+				       (if separate-window?
+					   (format "~a,new-window" str)
+					   str)))
+		      (process*/close-ports browser-path str)))]
+	       [else
+		(error 'open-url "Couldn't find Netscape or Opera to open URL: ~e" str)]))]
+	  [else (error 'send-url "don't know how to open URL on platform: ~s" (system-type))]))))
   
   ; null-input : iport
   (define null-input