config: add doc-open-url configuration

This configuration option is a better way to redirect documentation
access (at a place like NEU) than patching "search.rkt".

pkgs/racket-pkgs/racket-doc/help/help.scrbl

@@ -3,7 +3,8 @@
           (for-label racket
                      help/search
                      help/help-utils
-                     net/sendurl))
+                     net/sendurl
+                     setup/dirs))
 
 @title{Help and Documentation Utilities}
 
@@ -16,17 +17,25 @@ and to support bug reports. See also @racketmodname[scribble/xref].
 @defmodule[help/search]
 
 @defproc[(send-main-page [#:sub sub path-string? "index.html"]
-                         [#:notify notify (-> path? void) void]
+                         [#:notify notify (-> (or/c path? string?) void) void]
                          [#:fragment fragment (or/c #f string?) #f]
                          [#:query query (or/c #f string?) #f])
          any]{
   Visits the documentation file @racket[sub] in the user's browser. 
   
-  This function builds a URL that points into the main collection documentation
+  When @racket[get-doc-open-url] returns @racket[#f], @racket[send-main-page]
+  builds a URL that points into the main collection documentation
   or into the user-specific documentation, depending on the @racket[sub] argument.
   Once it finds the path, @racket[send-main-page] passes the path to
   @racket[notify]. The @racket[fragment] and @racket[query] arguments are passed
   to @racket[send-url/file], along with the URL.
+
+  When @racket[get-doc-open-url] returns a URL string,
+  @racket[send-main-page] appends @racket[sub] to the URL and passes
+  it to @racket[notify]. It then appends @racket[fragment] and
+  @racket[query] to the URL and passes it on to @racket[send-url].
+
+  @history[#:changed "6.0.1.6" @elem{Added @racket[get-doc-open-url] support.}]
 }
 
 @defproc[(perform-search [str string?]

pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl

@@ -105,6 +105,12 @@ directory}:
        with version and search-tag queries to form a remote
        documentation reference.}
 
+ @item{@indexed-racket['doc-open-url] --- a URL string or @racket[#f];
+       a string supplies a URL that is used instead of a local path to
+       search and maybe open documentation pages (which normally makes
+       sense only in an environment where opening a local HTML file
+       does not work).}
+
  @item{@indexed-racket['include-dir] --- a path, string, or byte string for
        the main directory containing C header files. It defaults to an
        @filepath{include} sibling directory of the @tech{main collection

pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -1174,6 +1174,15 @@ function for installing a single @filepath{.plt} file.
   Returns a string that is used by the documentation system, augmented
   with a version and search-key query, for remote documentation links.}
 
+@defproc[(get-doc-open-url) (or/c string? #f)]{
+  Returns @racket[#f] or a string for a root URL to be used as an
+  alternative to opening a local file for documentation. A
+  non-@racket[#f] configuration means that DrRacket, for example,
+  performs keyword searches for documentation via the specified URL
+  instead of from locally installed documentation.
+
+  @history[#:added "6.0.1.6"]}
+
 @defproc[(get-installation-name) string?]{ Returns the current
   installation's name, which is often @racket[(version)] but can be
   configured via @racket['installation-name] in @filepath{config.rktd}

pkgs/scribble-pkgs/scribble-lib/help/search.rkt

@@ -1,6 +1,10 @@
 #lang racket/base
 
-(require setup/dirs net/sendurl net/uri-codec)
+(require setup/dirs
+         net/sendurl
+         net/uri-codec
+         net/url
+         racket/string)
 (provide perform-search send-main-page)
 
 (define search-dir "search/")
@@ -11,13 +15,40 @@
 (define (send-main-page #:sub [sub "index.html"]
                         #:fragment [fragment #f] #:query [query #f]
                         #:notify [notify void])
-  (let* ([path (build-path (find-user-doc-dir) sub)]
+  (define open-url (get-doc-open-url))
-         [path (if (file-exists? path) path (build-path (find-doc-dir) sub))])
+  (cond
-    (notify path)
+   [open-url
-    (send-url/file path #:fragment fragment #:query query)))
+    (define dest-url (let ([u (string->url open-url)])
+                       (combine-url/relative
+                        u
+                        (string-join
+                         (for/list ([s (explode-path sub)])
+                           (if (path? s)
+                               (path-element->string s)
+                               (format "~a" s)))
+                         "/"))))
+    (notify (url->string dest-url))
+    (send-url (url->string
+               (struct-copy url dest-url
+                            [fragment (or fragment
+                                          (url-fragment dest-url))]
+                            [query (append
+                                    (url-query dest-url)
+                                    (if query
+                                        (url-query
+                                         (string->url
+                                          (format "q?~a" query)))
+                                        null))])))]
+   [else
+    (let* ([path (build-path (find-user-doc-dir) sub)]
+           [path (if (file-exists? path) path (build-path (find-doc-dir) sub))])
+      (notify path)
+      (send-url/file path #:fragment fragment #:query query))]))
 
 ;; This is an example of changing this code to use the online manuals.
-;; Useful in cases like schools that use systems that have problems
+;; Normally, it's better to set `doc-open-url` in "etc/config.rktd",
+;; but as a last resort, you can change `send-main-page` to compute a URL.
+;; This may be useful in cases like schools that use systems that have problems
 ;; running a browser on local files (like NEU).  If you use this, then
 ;; it is a good idea to put the documentation tree somewhere local, to
 ;; have better interaction times instead of using the PLT server.

racket/collects/setup/dirs.rkt

@@ -69,6 +69,7 @@
 (define-config config:3m-suffix '3m-suffix values)
 (define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
 (define-config config:doc-search-url 'doc-search-url values)
+(define-config config:doc-open-url 'doc-open-url values)
 (define-config config:installation-name 'installation-name values)
 (define-config config:build-stamp 'build-stamp values)
 
@@ -76,6 +77,7 @@
          get-cgc-suffix
          get-3m-suffix
          get-doc-search-url
+         get-doc-open-url
          get-installation-name
          get-build-stamp)
 
@@ -84,6 +86,7 @@
 (define (get-3m-suffix) (force config:3m-suffix))
 (define (get-doc-search-url) (or (force config:doc-search-url)
                                  "http://docs.racket-lang.org/local-redirect/index.html"))
+(define (get-doc-open-url) (force config:doc-open-url))
 (define (get-installation-name) (or (force config:installation-name)
                                     (version)))
 (define (get-build-stamp) (force config:build-stamp))