suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make `doc/local-redirect' also handle search links

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-11 10:05:05 -06:00
parent 5c222ca078
commit b5842d94a5
4 changed files with 76 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/distro-build/doc.txt
View File

@ -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

2
pkgs/distro-build/url-options.rkt
View File

@ -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)

12
pkgs/racket-pkgs/racket-index/scribblings/main/local-redirect.scrbl
View File

@ -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)

95
pkgs/racket-pkgs/racket-index/scribblings/main/private/local-redirect.rkt
View File

@ -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)))