much improved search, extended and fixed sendurl, string-based rendering for xrefs

svn: r8577

original commit: 7539945a3d

collects/net/scribblings/sendurl.scrbl

@@ -13,7 +13,8 @@ See also @schememodname[browser/external], which requires
 browser preference is set.
 
 
-@defproc[(send-url [str string?] [separate-window? any/c #t])
+@defproc[(send-url [str string?] [separate-window? any/c #t]
+                   #:escape [escape? any/c #t])
          void?]{
 
 Opens @scheme[str], which represents a URL, in a platform-specific
@@ -22,16 +23,51 @@ manner. For some platforms and configurations, the
 a new window to display the URL or not.
 
 Under Windows, @scheme[send-url] normally uses @scheme[shell-execute]
-to launch a browser. If the URL appears to contain a fragment, it may
+to launch a browser. (If the URL appears to contain a fragment, it may
-instead use @exec{ftype htmlfile} to obtain a command-line to run,
+use an intermediate redirecting file due to a bug in IE7.)
-since @scheme[shell-execute] drops a fragment.
 
 Under Mac OS X, @scheme[send-url] runs @exec{osascript} to start the
 user's chosen browser.
 
 Under Unix, @scheme[send-url] uses the value of the
-@scheme[external-browser] parameter to select a browser.}
+@scheme[external-browser] parameter to select a browser.
 
+The @scheme[url] string is usually escaped to avoid dangerous shell
+characters (quotations, dollar signs, backslashes, and non-ASCII).
+Note that it is a good idea to encode URLs before passing them to this
+function.  Also note that the encoding is meant to make the URL work
+in shell quotes: URLs can still hold characters like @litchar{#},
+@litchar{?}, and @litchar{&}, so the @scheme[external-browser] should
+use quotations.}
+
+@defproc[(send-url/file [path path-string?] [separate-window? any/c #t]
+                        #:fragment [fragment (or/c string? false/c) #f]
+                        #:query [query (or/c string? false/c) #f])
+         void?]{
+
+Similar to @scheme[send-url], but accepts a path to a file to be
+displayed by the browser.  Use this function when you want to display
+a local file: it takes care of the peculiarities of constructing the
+correct @litchar{file://} URL, and uses @scheme[send-url] to display
+the file.  If you need to use an anchor fragment or a query string,
+use the corresponding keyword arguments.}
+
+@defproc[(send-url/contents [contents string?] [separate-window? any/c #t]
+                            #:fragment [fragment (or/c string? false/c) #f]
+                            #:query [query (or/c string? false/c) #f]
+                            #:delete-at [seconds (or/c number? false/c) #f])
+         void?]{
+
+Similar to @scheme[send-url/file], but it consumes the contents of a
+page to show, and displayes it from a temporary file.
+
+If @scheme[delete-at] is a number, the temporary file is removed after
+this many seconds.  The deletion happens in a thread, so if mzscheme
+exits before that it will not happen --- when this function is called
+it scans old generated files (this happens randomly, not on every
+call) and removes them to avoid cluttering the temporary directory.
+If @scheme[delete-at] is @scheme[#f], no delayed deletion happens, but
+old temporary files are still deleted as described above.}
 
 @defparam[external-browser cmd browser-preference?]{
 

collects/net/sendurl.ss

@@ -8,7 +8,7 @@
          scheme/promise
          scheme/port)
 
-(provide send-url send-url/file
+(provide send-url send-url/file send-url/contents
          unix-browser-list browser-preference? external-browser)
 
 (define separate-by-default?
@@ -77,7 +77,7 @@
 ;; only these characters.  This is only for protection when passing arguments
 ;; to subprocesses, it's best to pass properly escaped urls to `send-url'.
 (define (escape-url url)
-  (regexp-replace* #px"(?:[^[:graph:]]|[\"'`\\\\])" url %escape))
+  (regexp-replace* #px"(?:[^[:graph:]]|[$\"'`\\\\])" url %escape))
 
 ;; send-url : str [bool] -> void
 (define (send-url url-str [separate-window? separate-by-default?]
@@ -117,6 +117,34 @@
                    path)])
     (send-url path separate-window? #:escape? #f)))
 
+;; See the documentation for the `delete-at' argument
+(define (send-url/contents contents [separate-window? separate-by-default?]
+                           #:fragment [fragment #f] #:query [query #f]
+                           #:delete-at [delete-at #f])
+  (define tmp-tmpl "plt-sendurl-contents-file-~a.html")
+  (define tmp-rx   #rx"^plt-sendurl-contents-file-.*\\.html$")
+  ;; The code below will often leave leftovers (for example, plt-help will quit
+  ;; before deletion happens), so every once in a while, do a cleanup.  This
+  ;; can also remove files that were created with no intention for deletion
+  ;; (when delete-at is #f), so don't remove files that are less than 15
+  ;; minutes old.
+  (when (zero? (random 5))
+    (parameterize ([current-directory (find-system-path 'temp-dir)])
+      (let ([now (current-seconds)])
+        (for ([file (directory-list)]
+              #:when (and (file-exists? file)
+                          (regexp-match tmp-rx (path-element->string file))
+                          (> (- now (file-or-directory-modify-seconds file))
+                             (* 15 60))))
+          ;; The temp directory may be shared with other users, so silently
+          ;; ignore failures to remove files.
+          (with-handlers ([void void]) (delete-file file))))))
+  (let ([temp (make-temporary-file tmp-tmpl)])
+    (with-output-to-file temp #:exists 'truncate
+      (lambda () (display contents)))
+    (when delete-at (thread (lambda () (sleep delete-at) (delete-file temp))))
+    (send-url/file temp)))
+
 (define osascript (delay (find-exe "osascript")))
 (define (send-url/mac url)
   (browser-run (force osascript) "-e" (format "open location \"~a\"" url)))
@@ -176,45 +204,27 @@
 ;;   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'.
-;; The current solution is to run `ftype http' to find the default browser
+;; One possible solution is to run `ftype http' to find the default browser
-;; command, if it uses `iexplore.exe', then change it to `explorer.exe', and
+;; 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/
-;; Hopefully this works.  One question is whether IE6 will still work fine;
+;; But this still fails on Vista, since the problem there is that launching a
-;; another is other browsers work; and finally, we need to parse the command
+;; browser with a file:// URL makes it start a more priviliged process, and
-;; and substitute the url for `%1' (if it appears).  If there are other `%'s,
+;; doing that drops the fragment again.  So the solution that the code below
-;; throw an error so we can hack that in too.
+;; implements is to write and use (via `send-url/contents') a trampoline html
-;; Oh and it seems that there is no way to get this to work on Vista, the above
+;; that redirects to the actual file and fragment.
-;; 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 windows-http-command
-  (delay (let ([out (open-output-string)])
-           (parameterize ([current-output-port out]
-                          [current-input-port (open-input-string "")]
-                          [current-error-port (open-output-nowhere)])
-             (and (system "ftype http")
-                  (cond [(regexp-match #rx"(?:^|\r?\n)?http=([^\r\n]+)\r?\n"
-                                       (get-output-string out))
-                         => cadr]
-                        [else #f]))))))
 
 (define (send-url/win url)
-  (let ([cmd (force windows-http-command)])
+  (if (not (regexp-match? #rx"[#?]" url))
-    (browser-run
+    (shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)
-     #:shell #t #:ignore-exit-code #t
+    (send-url/contents
-     (cond [(and (or (not cmd)
+     (string-append
-                     (regexp-match? #px"(?:^|[/\\\\])(?i:iexplore.exe)" cmd))
+      "<html><head><meta http-equiv=\"refresh\" content=\"0;URL="url"\"></head>"
-                 ;; IE: try to find exeplorer instead
+      "<body>Please go <a href=\""url"\">here</a>.</body></html>")
-                 (find-exe "explorer.exe"))
+     ;; starting the browser may take a while, don't remove the file
-            => (lambda (exe) (format "\"~a\" ~a" exe url))]
+     ;; immediately (this means that when used via plt-help, these files are
-           [(not (regexp-match? #rx"%" cmd))
+     ;; never removed by a timer)
-            (format "~a ~a" cmd url)]
+     #:delete-at 15)))
-           [(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
 (define (browser-run #:shell [shell? #f] #:ignore-exit-code [nowait? #f] . args)