From b5842d94a5fde793937634a4aff7aea2ca325550 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 11 Jul 2013 10:05:05 -0600
Subject: [PATCH] make `doc/local-redirect' also handle search links

---
 pkgs/distro-build/doc.txt                     |  4 +-
 pkgs/distro-build/url-options.rkt             |  2 +-
 .../scribblings/main/local-redirect.scrbl     | 12 ++-
 .../main/private/local-redirect.rkt           | 95 ++++++++++++-------
 4 files changed, 76 insertions(+), 37 deletions(-)

diff --git a/pkgs/distro-build/doc.txt b/pkgs/distro-build/doc.txt
index e1df8ff9ff..bdd495078d 100644
--- a/pkgs/distro-build/doc.txt
+++ b/pkgs/distro-build/doc.txt
@@ -133,8 +133,8 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
   #:doc-search <string> --- URL to install as the configuration for
     remote documentation searches in generated installers; "" is
     replaced with the PLT default; defaults to #:dist-base-url (if
-    present) extended with "doc/search.html", or the `DOC_SEARCH'
-    makefile variable
+    present) extended with "doc/local-redirect/index.html", or the
+    `DOC_SEARCH' makefile variable
 
   #:dist-name <string> --- the distribution name; defaults to the
     `DIST_NAME' makefile variable
diff --git a/pkgs/distro-build/url-options.rkt b/pkgs/distro-build/url-options.rkt
index 3ccece267f..1f4774a0cb 100644
--- a/pkgs/distro-build/url-options.rkt
+++ b/pkgs/distro-build/url-options.rkt
@@ -9,7 +9,7 @@
       (let ([v (hash-ref config '#:dist-base-url #f)])
         (and v
              (url->string
-              (combine-url/relative (string->url v) "docs/search.html"))))
+              (combine-url/relative (string->url v) "docs/local-redirect/index.html"))))
       default-doc-search))
 
 (define (choose-catalogs config default-catalogs)
diff --git a/pkgs/racket-pkgs/racket-index/scribblings/main/local-redirect.scrbl b/pkgs/racket-pkgs/racket-index/scribblings/main/local-redirect.scrbl
index 21c1e0229d..0aa06aaae2 100644
--- a/pkgs/racket-pkgs/racket-index/scribblings/main/local-redirect.scrbl
+++ b/pkgs/racket-pkgs/racket-index/scribblings/main/local-redirect.scrbl
@@ -1,8 +1,16 @@
 #lang scribble/manual
 @(require "private/local-redirect.rkt")
 
-@title{Local Redirections}
+@;{
+ This document causes the redirection table to be built,
+ in addition to acting as a target to trigger a search-based
+ redirection.
+}
 
-This document causes the redirection table to be built.
+@title{Redirections}
+
+This page that is intended to redirect to the result of a search
+request. Since you're reading this, it seems that the redirection
+did not work.
 
 @(make-local-redirect #f)
diff --git a/pkgs/racket-pkgs/racket-index/scribblings/main/private/local-redirect.rkt b/pkgs/racket-pkgs/racket-index/scribblings/main/private/local-redirect.rkt
index 3d1c867725..628535326c 100644
--- a/pkgs/racket-pkgs/racket-index/scribblings/main/private/local-redirect.rkt
+++ b/pkgs/racket-pkgs/racket-index/scribblings/main/private/local-redirect.rkt
@@ -4,7 +4,8 @@
          racket/class
          racket/match
          setup/dirs
-         net/url)
+         net/url
+         scribble/html-properties)
 
 (provide make-local-redirect)
 
@@ -41,35 +42,65 @@
     AddOnLoad(convert_all_links);
   }|)
 
+(define search-code
+  @string-append|{
+    /* http://stackoverflow.com/questions/901115/how-can-i-get-query-string-values */
+    function getParameterByName(name) {
+        name = name.replace(/[\[]/, "\\\[").replace(/[\]]/, "\\\]");
+        var regex = new RegExp("[\\?&]" + name + "=([^&#]*)"),
+            results = regex.exec(location.search);
+        return results == null ? false : decodeURIComponent(results[1].replace(/\+/g, " "));
+    }
+
+    var tag = getParameterByName("tag");
+    if (tag) {
+      var r = bsearch(tag, 0, link_targets.length);
+      if (r) {
+        window.onload = function() {
+          window.location = link_targets[r][1];
+        }
+      } else {
+        
+      }
+    }
+ }|)
+
 (define (make-local-redirect user?)
-  (make-render-element
-   #f
-   null
-   (lambda (renderer p ri)
-     (define keys (resolve-get-keys #f ri (lambda (v) #t)))
-     (define (target? v) (and (vector? v) (= 5 (vector-length v))))
-     (define dest (build-path (send renderer get-dest-directory #t) 
-                              "local-redirect.js"))
-     (define db
-       (sort (for/list ([k (in-list keys)]
-                        #:when (tag? k)
-                        #:when (target? (resolve-get p ri k)))
-               (list (send renderer tag->query-string k)
-                     (send renderer tag->url-string ri k #:absolute? user?)))
-             string<?
-             #:key car))
-     (call-with-output-file*
-      dest
-      #:exists 'truncate/replace
-      (lambda (o)
-        (fprintf o "// Autogenerated by `scribblings/main/private/local-redirect'\n")
-        (fprintf o "//  This script is included by generated documentation to rewrite\n")
-        (fprintf o "//  links expressed as tag queries into local-filesystem links.\n")
-        (newline o)
-        (fprintf o "var link_targets = [")
-        (for ([e (in-list db)]
-              [i (in-naturals)])
-          (fprintf o (if (zero? i) "\n" ",\n"))
-          (fprintf o " [~s, ~s]" (car e) (cadr e)))
-        (fprintf o "];\n\n")
-        (fprintf o rewrite-code))))))
+  (list
+   (make-render-element
+    #f
+    null
+    (lambda (renderer p ri)
+      (define keys (resolve-get-keys #f ri (lambda (v) #t)))
+      (define (target? v) (and (vector? v) (= 5 (vector-length v))))
+      (define dest (build-path (send renderer get-dest-directory #t) 
+                               "local-redirect.js"))
+      (define db
+        (sort (for/list ([k (in-list keys)]
+                         #:when (tag? k)
+                         #:when (target? (resolve-get p ri k)))
+                (list (send renderer tag->query-string k)
+                      (send renderer tag->url-string ri k #:absolute? user?)))
+              string<?
+              #:key car))
+      (call-with-output-file*
+       dest
+       #:exists 'truncate/replace
+       (lambda (o)
+         (fprintf o "// Autogenerated by `scribblings/main/private/local-redirect'\n")
+         (fprintf o "//  This script is included by generated documentation to rewrite\n")
+         (fprintf o "//  links expressed as tag queries into local-filesystem links.\n")
+         (newline o)
+         (fprintf o "var link_targets = [")
+         (for ([e (in-list db)]
+               [i (in-naturals)])
+           (fprintf o (if (zero? i) "\n" ",\n"))
+           (fprintf o " [~s, ~s]" (car e) (cadr e)))
+         (fprintf o "];\n\n")
+         (fprintf o rewrite-code)))))
+   (element
+    (style #f (list
+               (js-addition (string->url "local-redirect.js"))
+               (js-addition
+                (string->bytes/utf-8 search-code))))
+    null)))