doc search & redirect: user as an extension of main
When rendering the user documentation-search page or
local-redirect page, only user-specific documentation is
included, which makes rendering faster and automatically
picks up any installation-scope additions.
The documentation start page is still static, so the
user version doesn't pick up installation-scope
additions in the same way.
Related to PR 14180
(cherry picked from commit 7bba67d107
)
This commit is contained in:
parent
560d4c55ad
commit
e249acdbed
|
@ -347,12 +347,17 @@ Optional @filepath{info.rkt} fields trigger additional actions by
|
|||
|
||||
@item{@racket['depends-all] : Indicates that the document should
|
||||
be re-built if any other document is rebuilt---except for
|
||||
documents that have the @racket['no-depends-on] mode.}
|
||||
documents that have the @racket['no-depend-on] mode.}
|
||||
|
||||
@item{@racket['depends-all-main] : Indicates that the document
|
||||
should be re-built if any other document is rebuilt that is
|
||||
installed into the main installation---except for documents
|
||||
that have the @racket['no-depends-on] mode.}
|
||||
that have the @racket['no-depend-on] mode.}
|
||||
|
||||
@item{@racket['depends-all-user] : Indicates that the document
|
||||
should be re-built if any other document is rebuilt that is
|
||||
installed into the user's space---except for documents
|
||||
that have the @racket['no-depend-on] mode.}
|
||||
|
||||
@item{@racket['always-run] : Build the document every time that
|
||||
@exec{raco setup} is run, even if none of its dependencies
|
||||
|
|
|
@ -0,0 +1,19 @@
|
|||
#lang racket/base
|
||||
(require setup/dirs
|
||||
racket/path)
|
||||
|
||||
(provide index-at-user?)
|
||||
|
||||
(define (index-at-user?)
|
||||
(define p
|
||||
(find-relative-path
|
||||
(collection-file-path "index-scope.rkt" "scribblings/main/private")
|
||||
(find-user-pkgs-dir)
|
||||
#:more-than-root? #t))
|
||||
(and (path? p)
|
||||
(let loop ([p p])
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(and (eq? name 'up)
|
||||
(or (and (path? base)
|
||||
(loop base))
|
||||
(eq? base 'relative)))))))
|
|
@ -5,41 +5,51 @@
|
|||
racket/match
|
||||
setup/dirs
|
||||
net/url
|
||||
scribble/html-properties)
|
||||
scribble/html-properties
|
||||
"index-scope.rkt")
|
||||
|
||||
(provide make-local-redirect)
|
||||
|
||||
(define rewrite-code
|
||||
(define (rewrite-code user?)
|
||||
(define prefix (if user? "user_" ""))
|
||||
@string-append|{
|
||||
function bsearch(str, start, end) {
|
||||
function |@|prefix|bsearch(str, start, end) {
|
||||
if (start >= end)
|
||||
return false;
|
||||
else {
|
||||
var mid = Math.floor((start + end) / 2);
|
||||
if (link_targets[mid][0] == str)
|
||||
if (|@|prefix|link_targets[mid][0] == str)
|
||||
return mid;
|
||||
else if (link_targets[mid][0] < str)
|
||||
return bsearch(str, mid+1, end);
|
||||
else if (|@|prefix|link_targets[mid][0] < str)
|
||||
return |@|prefix|bsearch(str, mid+1, end);
|
||||
else
|
||||
return bsearch(str, start, mid);
|
||||
return |@|prefix|bsearch(str, start, mid);
|
||||
}
|
||||
}
|
||||
|
||||
function convert_all_links() {
|
||||
var |@|prefix|link_target_prefix = false;
|
||||
|
||||
function |@|prefix|convert_all_links() {
|
||||
var elements = document.getElementsByClassName("Sq");
|
||||
for (var i = 0; i < elements.length; i++) {
|
||||
var elem = elements[i];
|
||||
var n = elem.href.match(/tag=[^&]*/);
|
||||
if (n) {
|
||||
var pos = bsearch(decodeURIComponent(n[0].substring(4)), 0, link_targets.length);
|
||||
var pos = |@|prefix|bsearch(decodeURIComponent(n[0].substring(4)),
|
||||
0,
|
||||
|@|prefix|link_targets.length);
|
||||
if (pos) {
|
||||
elem.href = link_targets[pos][1];
|
||||
var p = |@|prefix|link_targets[pos][1];
|
||||
if (|@|prefix|link_target_prefix) {
|
||||
p = |@|prefix|link_target_prefix + p;
|
||||
}
|
||||
elem.href = p;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
AddOnLoad(convert_all_links);
|
||||
AddOnLoad(|@|prefix|convert_all_links);
|
||||
}|)
|
||||
|
||||
(define search-code
|
||||
|
@ -66,15 +76,29 @@
|
|||
}|)
|
||||
|
||||
(define (make-local-redirect user?)
|
||||
(define main-at-user? (index-at-user?))
|
||||
(list
|
||||
(make-render-element
|
||||
#f
|
||||
null
|
||||
(lambda (renderer p ri)
|
||||
(define keys (resolve-get-keys #f ri (lambda (v) #t)))
|
||||
(define keys (if (and main-at-user? (not user?))
|
||||
;; If there's no installation-scope "doc", then
|
||||
;; the "main" redirection table is useless.
|
||||
null
|
||||
(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 dest-dir (send renderer get-dest-directory #t))
|
||||
(define (make-dest user?)
|
||||
(build-path dest-dir
|
||||
(if user?
|
||||
"local-user-redirect.js"
|
||||
"local-redirect.js")))
|
||||
(define dest (make-dest user?))
|
||||
(define alt-dest (make-dest (not user?)))
|
||||
;; Whether references include user and/or main docs is determined
|
||||
;; by 'depends-all-main, 'depends-all-user, or 'depends-all flag
|
||||
;; in "info.rkt".
|
||||
(define db
|
||||
(sort (for/list ([k (in-list keys)]
|
||||
#:when (tag? k)
|
||||
|
@ -91,16 +115,31 @@
|
|||
(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 = [")
|
||||
(fprintf o "link_target_prefix = ~s;\n" (url->string
|
||||
(path->url
|
||||
(path->directory-path
|
||||
(build-path (find-doc-dir) "local-redirect")))))
|
||||
(newline o)
|
||||
(fprintf o "var ~alink_targets = [" (if user? "user_" ""))
|
||||
(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)))))
|
||||
(fprintf o (rewrite-code user?))))
|
||||
(unless (file-exists? alt-dest)
|
||||
;; make empty alternate file; in `user?` mode, this
|
||||
;; file will get used only when "racket-index" is not
|
||||
;; in installation scope
|
||||
(call-with-output-file* alt-dest void))))
|
||||
(element
|
||||
(style #f (list
|
||||
(js-addition (string->url "local-redirect.js"))
|
||||
(js-addition (if (and user? (not main-at-user?))
|
||||
(path->url (build-path (find-doc-dir)
|
||||
"local-redirect"
|
||||
"local-redirect.js"))
|
||||
(string->url "local-redirect.js")))
|
||||
(js-addition (string->url "local-user-redirect.js"))
|
||||
(js-addition
|
||||
(string->bytes/utf-8 search-code))))
|
||||
null)))
|
||||
|
|
|
@ -21,11 +21,13 @@
|
|||
"utils.rkt"
|
||||
(for-syntax racket/base)
|
||||
(for-syntax racket/runtime-path)
|
||||
(for-syntax compiler/cm-accomplice))
|
||||
(for-syntax compiler/cm-accomplice)
|
||||
"index-scope.rkt")
|
||||
|
||||
(provide make-search)
|
||||
|
||||
(define-runtime-path search-script "search.js")
|
||||
(define-runtime-path search-merge-script "search-merge.js")
|
||||
|
||||
;; this file is used as a trampoline to set a context (a pre-filter cookie) and
|
||||
;; then hop over to the search page (the search page can do it itself, but it's
|
||||
|
@ -38,8 +40,10 @@
|
|||
;; installing, and they would just do that when appropriate.
|
||||
(begin-for-syntax
|
||||
(define-runtime-path search-script "search.js")
|
||||
(define-runtime-path search-merge-script "search-merge.js")
|
||||
(define-runtime-path search-context-page "search-context.html")
|
||||
(register-external-file search-script)
|
||||
(register-external-file search-merge-script)
|
||||
(register-external-file search-context-page))
|
||||
|
||||
(define (quote-string val)
|
||||
|
@ -57,7 +61,7 @@
|
|||
;; Quote unicode chars:
|
||||
(regexp-replace* #px"[^[:ascii:]]" str hex4)))
|
||||
|
||||
(define (make-script user-dir? renderer sec ri)
|
||||
(define (make-script as-empty? user-dir? renderer sec ri)
|
||||
(define dest-dir (send renderer get-dest-directory #t))
|
||||
(define span-classes null)
|
||||
;; To make the index smaller, html contents is represented as one of these:
|
||||
|
@ -109,7 +113,9 @@
|
|||
(define manual-refs (make-hash))
|
||||
(define idx -1)
|
||||
(define l
|
||||
(for/list ([i (get-index-entries sec ri)]
|
||||
(for/list ([i (if as-empty?
|
||||
null
|
||||
(get-index-entries sec ri))]
|
||||
;; don't index constructors (the class itself is already indexed)
|
||||
#:unless (constructor-index-desc? (list-ref i 3)))
|
||||
(set! idx (add1 idx))
|
||||
|
@ -166,6 +172,8 @@
|
|||
(quote-string href) ","
|
||||
html "," from-libs "]")))
|
||||
|
||||
(define user (if user-dir? "user_" ""))
|
||||
|
||||
(with-output-to-file (build-path dest-dir "plt-index.js") #:exists 'truncate
|
||||
(lambda ()
|
||||
(for-each
|
||||
|
@ -179,7 +187,7 @@
|
|||
@||
|
||||
// classes to be used for compact representation of html strings in
|
||||
// plt_search_data below (see also the UncompactHtml function)
|
||||
var plt_span_classes = [
|
||||
var plt_@,|user|span_classes = [
|
||||
@,@(add-between (map (lambda (x) (quote-string (car x)))
|
||||
(reverse span-classes))
|
||||
",\n ")
|
||||
|
@ -192,12 +200,12 @@
|
|||
// index into plt_span_classes (note: this is recursive)
|
||||
// - from_lib is an array of module names for bound identifiers,
|
||||
// or the string "module" for a module entry
|
||||
var plt_search_data = [
|
||||
var plt_@,|user|search_data = [
|
||||
@,@(add-between l ",\n")
|
||||
];
|
||||
@||
|
||||
// array of pointers to the previous array, for items that are manuals
|
||||
var plt_manual_ptrs = {
|
||||
var plt_@,|user|manual_ptrs = {
|
||||
@,@(let* ([ms (hash-map manual-refs cons)]
|
||||
[ms (sort ms < #:key cdr)]
|
||||
[ms (map (lambda (x)
|
||||
|
@ -207,23 +215,42 @@
|
|||
(add-between ms ",\n "))};
|
||||
@||})))
|
||||
|
||||
(for ([src (list search-script search-context-page)])
|
||||
(for ([src (append (list search-script search-context-page)
|
||||
(if user-dir? (list search-merge-script) null))])
|
||||
(define dest (build-path dest-dir (file-name-from-path src)))
|
||||
(when (file-exists? dest) (delete-file dest))
|
||||
(copy-file src dest)))
|
||||
|
||||
(define (make-search user-dir?)
|
||||
(define (make-search in-user-dir?)
|
||||
(define main-at-user? (index-at-user?))
|
||||
(define user-dir? (and in-user-dir? (not main-at-user?)))
|
||||
(make-splice
|
||||
(list
|
||||
(make-paragraph
|
||||
plain
|
||||
(list
|
||||
(script-ref "plt-index.js"
|
||||
#:noscript
|
||||
@list{Sorry, you must have JavaScript to use this page.})
|
||||
(script-ref "search.js")
|
||||
(make-render-element #f null
|
||||
(lambda (r s i) (make-script user-dir? r s i)))))
|
||||
(append
|
||||
(if user-dir?
|
||||
(list (script-ref (url->string
|
||||
(path->url
|
||||
(build-path (find-doc-dir) "search" "plt-index.js")))))
|
||||
null)
|
||||
(list
|
||||
(script-ref "plt-index.js"
|
||||
#:noscript
|
||||
@list{Sorry, you must have JavaScript to use this page.})
|
||||
(script-ref "search.js"))
|
||||
(if user-dir?
|
||||
(list (script-ref "search-merge.js"))
|
||||
null)
|
||||
(list
|
||||
(make-render-element #f null
|
||||
(lambda (r s i) (make-script
|
||||
;; If there's no installaton-scope docs,
|
||||
;; don't both creating "main" search page:
|
||||
(and main-at-user?
|
||||
(not in-user-dir?))
|
||||
user-dir?
|
||||
r s i))))))
|
||||
(make-paragraph (make-style #f
|
||||
(list 'div
|
||||
(make-attributes '([id . "plt_search_container"]))))
|
||||
|
|
|
@ -0,0 +1,57 @@
|
|||
|
||||
// Merge user and main search arrays
|
||||
{
|
||||
var orig_span_length = plt_span_classes.length;
|
||||
|
||||
plt_span_classes = plt_span_classes.concat(plt_user_span_classes);
|
||||
|
||||
var rev_map = [], user_rev_map = [];
|
||||
for (name in plt_manual_ptrs)
|
||||
rev_map[plt_manual_ptrs[name]] = name;
|
||||
for (name in plt_user_manual_ptrs)
|
||||
user_rev_map[plt_manual_ptrs[name]] = name;
|
||||
|
||||
// Convert a span by adjusting the span-index offset
|
||||
|
||||
function convert_span(x) {
|
||||
if (typeof x == "string") {
|
||||
return x;
|
||||
} else if ((x.length == 2) && (typeof(x[0]) == "number")) {
|
||||
return [x[0] + orig_span_length, convert_span(x[1])];
|
||||
} else {
|
||||
var res = [];
|
||||
for (var i=0; i<x.length; i++)
|
||||
res[i] = convert_span(x[i]);
|
||||
return res;
|
||||
}
|
||||
}
|
||||
|
||||
function convert(line) {
|
||||
return [line[0], line[1], convert_span(line[2]), line[3]];
|
||||
}
|
||||
|
||||
var i = 0, j = 0;
|
||||
var ilen = plt_search_data.length;
|
||||
var jlen = plt_user_search_data.length;
|
||||
var result = []
|
||||
while ((i < ilen) || (j < jlen)) {
|
||||
if (j >= jlen) {
|
||||
if (rev_map[i]) plt_manual_ptrs[rev_map[i]] = result.length;
|
||||
result.push(plt_search_data[i]);
|
||||
i++;
|
||||
} else if (i >= ilen) {
|
||||
if (user_rev_map[j]) plt_manual_ptrs[user_rev_map[j]] = result.length;
|
||||
result.push(convert(plt_user_search_data[j]));
|
||||
j++;
|
||||
} else if (plt_search_data[i][0] < plt_user_search_data[j][0]) {
|
||||
if (rev_map[i]) plt_manual_ptrs[rev_map[i]] = result.length;
|
||||
result.push(plt_search_data[i]);
|
||||
i++;
|
||||
} else {
|
||||
if (user_rev_map[j]) plt_manual_ptrs[user_rev_map[j]] = result.length;
|
||||
result.push(convert(plt_user_search_data[j]));
|
||||
j++;
|
||||
}
|
||||
}
|
||||
plt_search_data = result;
|
||||
}
|
|
@ -2,6 +2,6 @@
|
|||
|
||||
(define scribblings
|
||||
'(("start.scrbl" (user-doc-root depends-all no-depend-on) (omit))
|
||||
("search.scrbl" (user-doc depends-all no-depend-on) (omit))
|
||||
("local-redirect.scrbl" (user-doc depends-all no-depend-on) (omit))
|
||||
("search.scrbl" (user-doc depends-all-user no-depend-on) (omit))
|
||||
("local-redirect.scrbl" (user-doc depends-all-user no-depend-on) (omit))
|
||||
("release.scrbl" (user-doc depends-all no-depend-on) (omit))))
|
||||
|
|
|
@ -146,7 +146,8 @@
|
|||
(log-setup-info "latex working directory: ~a" latex-dest))
|
||||
(define (scribblings-flag? sym)
|
||||
(memq sym '(main-doc main-doc-root user-doc-root user-doc multi-page
|
||||
depends-all depends-all-main no-depend-on always-run)))
|
||||
depends-all depends-all-main depends-all-user
|
||||
no-depend-on always-run)))
|
||||
(define (validate-scribblings-infos infos)
|
||||
(define (validate path [flags '()] [cat '(library)] [name #f] [out-count 1] [order-hint 0])
|
||||
(and (string? path) (relative-path? path)
|
||||
|
@ -435,7 +436,9 @@
|
|||
[added? #f]
|
||||
[deps (make-hasheq)]
|
||||
[known-deps (make-hasheq)]
|
||||
[all-main? (memq 'depends-all-main (doc-flags (info-doc info)))])
|
||||
[all-main? (memq 'depends-all-main (doc-flags (info-doc info)))]
|
||||
[all-user? (memq 'depends-all-user (doc-flags (info-doc info)))]
|
||||
[all? (memq 'depends-all (doc-flags (info-doc info)))])
|
||||
;; Convert current deps from paths to infos, keeping paths that have no info
|
||||
(set-info-deps!
|
||||
info
|
||||
|
@ -458,10 +461,14 @@
|
|||
(hash-set! deps i #t)
|
||||
;; Path has no info; normally keep it as expected, and it gets
|
||||
;; removed later.
|
||||
(unless (or (memq 'depends-all (doc-flags (info-doc info)))
|
||||
(unless (or all?
|
||||
(and (info? d)
|
||||
(doc-under-main? (info-doc d))
|
||||
all-main?))
|
||||
(cond
|
||||
[all-main?
|
||||
(doc-under-main? (info-doc d))]
|
||||
[all-user?
|
||||
(not (doc-under-main? (info-doc d)))]
|
||||
[else #f])))
|
||||
(set! added? #t)
|
||||
(verbose/log "Removed Dependency for ~a: ~a"
|
||||
(doc-name (info-doc info))
|
||||
|
@ -489,23 +496,28 @@
|
|||
(set! added? #t)
|
||||
(hash-set! deps i #t)]))
|
||||
;; Add expected dependencies for an "all dependencies" doc:
|
||||
(when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?)
|
||||
(when (or all? all-main? all-user?)
|
||||
(verbose/log "Adding all~a as dependencies for ~a"
|
||||
(if all-main? " main" "")
|
||||
(cond
|
||||
[all-main? " main"]
|
||||
[all-user? " user"]
|
||||
[else ""])
|
||||
(doc-name (info-doc info)))
|
||||
(for ([i infos])
|
||||
(hash-set! known-deps i #t)
|
||||
(when (and (not (eq? i info))
|
||||
(not (hash-ref deps i #f))
|
||||
(or (not all-main?) (doc-under-main? (info-doc i)))
|
||||
(cond
|
||||
[all-main? (doc-under-main? (info-doc i))]
|
||||
[all-user? (not (doc-under-main? (info-doc i)))]
|
||||
[else #t])
|
||||
(not (memq 'no-depend-on (doc-flags (info-doc i)))))
|
||||
(add-dependency info i))))
|
||||
;; Determine definite dependencies based on referenced keys, and also
|
||||
;; report missing links.
|
||||
(let ([not-found
|
||||
(lambda (k)
|
||||
(unless (or (memq 'depends-all (doc-flags (info-doc info)))
|
||||
(memq 'depends-all-main (doc-flags (info-doc info))))
|
||||
(unless (or all? all-main? all-user?)
|
||||
(unless one?
|
||||
(setup-printf
|
||||
"WARNING" "undefined tag in ~a:"
|
||||
|
@ -697,7 +709,7 @@
|
|||
(define shared-empty-script-files
|
||||
(list "doc-site.js"))
|
||||
|
||||
(define (make-renderer latex-dest doc)
|
||||
(define (make-renderer latex-dest doc main-doc-exists?)
|
||||
(if latex-dest
|
||||
(new (latex:render-mixin render%)
|
||||
[dest-dir latex-dest]
|
||||
|
@ -722,11 +734,16 @@
|
|||
[allow-indirect? (and (doc-pkg? doc)
|
||||
;; (not main?)
|
||||
(not (memq 'no-depend-on (doc-flags doc))))]
|
||||
[local-redirect-file (build-path (if main?
|
||||
[local-redirect-file (build-path (if main-doc-exists?
|
||||
(find-doc-dir)
|
||||
(find-user-doc-dir))
|
||||
"local-redirect"
|
||||
"local-redirect.js")])
|
||||
"local-redirect.js")]
|
||||
[local-user-redirect-file (build-path (if main?
|
||||
(find-doc-dir)
|
||||
(find-user-doc-dir))
|
||||
"local-redirect"
|
||||
"local-user-redirect.js")])
|
||||
(define r
|
||||
(new (contract-override-mixin
|
||||
((if multi? html:render-multi-mixin values)
|
||||
|
@ -743,14 +760,18 @@
|
|||
(if root?
|
||||
s
|
||||
(format "../~a" s))))])
|
||||
(cons (cons local-redirect-file
|
||||
(if main?
|
||||
"../local-redirect/local-redirect.js"
|
||||
(u:url->string (u:path->url local-redirect-file))))
|
||||
(map std-path (append
|
||||
shared-style-files
|
||||
shared-empty-style-files
|
||||
shared-empty-script-files))))]
|
||||
(list* (cons local-redirect-file
|
||||
(if main?
|
||||
"../local-redirect/local-redirect.js"
|
||||
(u:url->string (u:path->url local-redirect-file))))
|
||||
(cons local-user-redirect-file
|
||||
(if main?
|
||||
"../local-redirect/local-user-redirect.js"
|
||||
(u:url->string (u:path->url local-user-redirect-file))))
|
||||
(map std-path (append
|
||||
shared-style-files
|
||||
shared-empty-style-files
|
||||
shared-empty-script-files))))]
|
||||
[up-path (cond
|
||||
[root? #f] ; no up from root
|
||||
[main?
|
||||
|
@ -783,7 +804,7 @@
|
|||
;; For documentation that might be moved into a binary package
|
||||
;; or that can contain an indirect reference, use a server indirection
|
||||
;; for all links external to the document, but also install the
|
||||
;; "local-redirect.js" hook:
|
||||
;; "local-[user-]redirect.js" hooks:
|
||||
(send r set-external-tag-path
|
||||
(u:url->string
|
||||
(let ([u (u:string->url (get-doc-search-url))])
|
||||
|
@ -793,7 +814,8 @@
|
|||
[query
|
||||
(cons (cons 'version (version))
|
||||
(u:url-query u))]))))
|
||||
(send r add-extra-script-file local-redirect-file))
|
||||
(send r add-extra-script-file local-redirect-file)
|
||||
(send r add-extra-script-file local-user-redirect-file))
|
||||
;; Result is the renderer:
|
||||
r)))
|
||||
|
||||
|
@ -827,7 +849,8 @@
|
|||
(and auto-main?
|
||||
(memq 'depends-all-main (doc-flags doc)))
|
||||
(and auto-user?
|
||||
(memq 'depends-all (doc-flags doc)))
|
||||
(or (memq 'depends-all (doc-flags doc))
|
||||
(memq 'depends-all-user (doc-flags doc))))
|
||||
(ormap (lambda (d)
|
||||
(let ([d (path->directory-path d)])
|
||||
(let loop ([dir (path->directory-path (doc-src-dir doc))])
|
||||
|
@ -902,7 +925,8 @@
|
|||
(define xref (make-collections-xref
|
||||
#:quiet-fail? quiet-fail?
|
||||
#:no-user? (main-doc? doc)
|
||||
#:no-main? (not main-doc-exists?)
|
||||
#:no-main? (or (not main-doc-exists?)
|
||||
(memq 'depends-all-user (doc-flags doc)))
|
||||
#:doc-db (and latex-dest
|
||||
(find-doc-db-path latex-dest #t main-doc-exists?))
|
||||
#:register-shutdown! (lambda (s)
|
||||
|
@ -955,7 +979,7 @@
|
|||
;; need to render, so complain if no source is available:
|
||||
path)))]
|
||||
[src-sha1 (and src-zo (get-compiled-file-sha1 src-zo))]
|
||||
[renderer (make-renderer latex-dest doc)]
|
||||
[renderer (make-renderer latex-dest doc main-doc-exists?)]
|
||||
[can-run? (can-build? only-dirs doc)]
|
||||
[stamp-data (with-handlers ([exn:fail:filesystem? (lambda (exn) (list "" "" ""))])
|
||||
(let ([v (call-with-input-file* stamp-file read)])
|
||||
|
@ -1007,7 +1031,8 @@
|
|||
(and auto-main?
|
||||
(memq 'depends-all-main (doc-flags doc)))
|
||||
(and auto-user?
|
||||
(memq 'depends-all (doc-flags doc)))))])
|
||||
(or (memq 'depends-all (doc-flags doc))
|
||||
(memq 'depends-all-user (doc-flags doc))))))])
|
||||
|
||||
(when (or (and (not up-to-date?) (not only-fast?))
|
||||
(verbose))
|
||||
|
@ -1224,11 +1249,20 @@
|
|||
;; and fix up the path if there is a reference:
|
||||
(define js-path (if (doc-under-main? doc)
|
||||
"../local-redirect"
|
||||
(u:url->string (u:path->url (build-path (find-user-doc-dir)
|
||||
"local-redirect")))))
|
||||
(u:url->string
|
||||
(u:path->url
|
||||
(build-path (if main-doc-exists?
|
||||
(find-doc-dir)
|
||||
(find-user-doc-dir))
|
||||
"local-redirect")))))
|
||||
(define user-js-path (if (doc-under-main? doc)
|
||||
"../local-redirect"
|
||||
(u:url->string
|
||||
(u:path->url
|
||||
(build-path (find-user-doc-dir) "local-redirect")))))
|
||||
(for ([p (in-directory dest-dir)])
|
||||
(when (regexp-match? #rx#"[.]html$" (path->bytes p))
|
||||
(fixup-local-redirect-reference p js-path)))
|
||||
(fixup-local-redirect-reference p js-path #:user user-js-path)))
|
||||
;; The existence of "synced.rktd" means that the db is in sync
|
||||
;; with "provides.sxref" and ".html" files have been updated.
|
||||
(let ([provided-path (build-path dest-dir "synced.rktd")])
|
||||
|
@ -1324,7 +1358,7 @@
|
|||
(load-sxref (sxref-path latex-dest doc (format "out~a.sxref" i))))))
|
||||
(define info (and (info? info-or-list) info-or-list))
|
||||
(define doc (if info (info-doc info) (car info-or-list)))
|
||||
(define renderer (make-renderer latex-dest doc))
|
||||
(define renderer (make-renderer latex-dest doc main-doc-exists?))
|
||||
(with-record-error
|
||||
(doc-src-file doc)
|
||||
(lambda ()
|
||||
|
|
|
@ -157,7 +157,7 @@
|
|||
[else (void)]))
|
||||
|
||||
(define (fixup-html new-p)
|
||||
;; strip full path to "local-redirect.js"
|
||||
;; strip full path to "local-[user-]redirect.js"
|
||||
(fixup-local-redirect-reference new-p ".."))
|
||||
|
||||
(define (fixup-zo new-p)
|
||||
|
@ -194,13 +194,18 @@
|
|||
#:exists 'truncate/replace
|
||||
(lambda (out) (write new-mod out)))))
|
||||
|
||||
(define (fixup-local-redirect-reference p js-path)
|
||||
(define (fixup-local-redirect-reference p js-path #:user [user-js-path js-path])
|
||||
;; Relying on this HTML pattern (as generated by Scribble's HTML
|
||||
;; renderer) is a little fragile. Any better idea?
|
||||
(define rx #rx"<script type=\"text/javascript\" src=\"([^\"]*)/local-redirect.js\">")
|
||||
(define m (call-with-input-file*
|
||||
p
|
||||
(lambda (i) (regexp-match-positions rx i))))
|
||||
(define rx #rx"<script type=\"text/javascript\" src=\"([^\"]*)/local-(?:user-)?redirect[.]js\">")
|
||||
(define ms (call-with-input-file*
|
||||
p
|
||||
(lambda (i)
|
||||
;; search twice to hit normal and user:
|
||||
(list (regexp-match-positions rx i)
|
||||
(regexp-match-positions rx i)))))
|
||||
(define m (car ms))
|
||||
(define m2 (cadr ms))
|
||||
(when m
|
||||
(define start (caadr m))
|
||||
(define end (cdadr m))
|
||||
|
@ -208,8 +213,17 @@
|
|||
(define new-bstr
|
||||
(bytes-append (subbytes bstr 0 start)
|
||||
(string->bytes/utf-8 js-path)
|
||||
(subbytes bstr end)))
|
||||
(call-with-output-file*
|
||||
(let ([s (subbytes bstr end)])
|
||||
(cond
|
||||
[m2
|
||||
(define delta (- (cdar m) end))
|
||||
(define start2 (caadr m2))
|
||||
(define end2 (cdadr m2))
|
||||
(bytes-append (subbytes s 0 (+ delta start2))
|
||||
(string->bytes/utf-8 user-js-path)
|
||||
(subbytes s (+ delta end2)))]
|
||||
[else s]))))
|
||||
(call-with-output-file*
|
||||
p
|
||||
#:exists 'truncate/replace
|
||||
(lambda (out) (write-bytes new-bstr out)))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user