diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index b62377ee..ecc242f2 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -219,6 +219,9 @@
quiet-table-of-contents)
(init-field [css-path #f]
+ ;; up-path is either a link "up", or #t which uses
+ ;; goes to start page (using cookies to get to the
+ ;; user start page)
[up-path #f]
[style-file #f]
[script-path #f]
@@ -620,14 +623,26 @@
prev-content)
sep-element
(make-element
- (if (or parent up-path)
- (make-target-url
- (cond [(not parent) up-path]
- [(and (toc-part? parent) (part-parent parent ri))
- (derive-filename parent)]
- [else "index.html"])
- #f)
- "nonavigation")
+ (cond
+ ;; up-path = #t => go up to the start page, using
+ ;; cookies to get to the user's version of it (see
+ ;; scribblings/main/private/utils for the code
+ ;; that creates these cookies.)
+ [(and (eq? #t up-path) (not parent))
+ (make-target-url
+ "../index.html"
+ (make-with-attributes
+ #f `([onclick
+ . ,(format "return GotoPLTRoot(\"~a\");"
+ (version))])))]
+ [(or parent up-path)
+ (make-target-url
+ (cond [(not parent) up-path]
+ [(and (toc-part? parent) (part-parent parent ri))
+ (derive-filename parent)]
+ [else "index.html"])
+ #f)]
+ [else "nonavigation"])
up-content)
sep-element
(make-element
@@ -754,18 +769,18 @@
(define/private (render-plain-element e part ri)
(let* ([raw-style (flatten-style (and (element? e) (element-style e)))]
[style (if (with-attributes? raw-style)
- (with-attributes-style raw-style)
- raw-style)]
+ (with-attributes-style raw-style)
+ raw-style)]
[attribs (lambda ()
(if (with-attributes? raw-style)
- (map (lambda (p) (list (car p) (cdr p)))
- (with-attributes-assoc raw-style))
- null))]
+ (map (lambda (p) (list (car p) (cdr p)))
+ (with-attributes-assoc raw-style))
+ null))]
[super-render/attribs
(lambda ()
(if (with-attributes? raw-style)
- `((span ,(attribs) ,@(super render-element e part ri)))
- (super render-element e part ri)))])
+ `((span ,(attribs) ,@(super render-element e part ri)))
+ (super render-element e part ri)))])
(cond
[(symbol? style)
(case style
@@ -809,20 +824,20 @@
,@(super render-element e part ri)))]
[(target-url? style)
(if (current-no-links)
- (super-render/attribs)
- (parameterize ([current-no-links #t])
- `((a ([href ,(let ([addr (target-url-addr style)])
- (if (path? addr)
- (from-root addr (get-dest-directory))
- addr))]
- ;; The target-url chains to another style. Allow
- ;; `with-attributes' inside as well as outside:
- ,@(let ([style (target-url-style style)])
- (if (string? style)
- `([class ,style])
- null))
- . ,(attribs))
- ,@(super render-element e part ri)))))]
+ (super-render/attribs)
+ (parameterize ([current-no-links #t])
+ `((a ([href ,(let ([addr (target-url-addr style)])
+ (if (path? addr)
+ (from-root addr (get-dest-directory))
+ addr))]
+ ;; The target-url chains to another style,
+ ;; flatten-style above takes care of it though.
+ ,@(let ([style (target-url-style style)])
+ (if (string? style)
+ `([class ,style])
+ null))
+ . ,(attribs))
+ ,@(super render-element e part ri)))))]
[(url-anchor? style)
`((a ([name ,(url-anchor-name style)] . ,(attribs))
,@(super render-element e part ri)))]
diff --git a/collects/scribble/scribble-common.js b/collects/scribble/scribble-common.js
index 97cd0388..c1aab351 100644
--- a/collects/scribble/scribble-common.js
+++ b/collects/scribble/scribble-common.js
@@ -19,19 +19,21 @@ function SetCookie(key, val) {
key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
}
-function GotoPLTRoot(ver) {
- var u = GetCookie("PLT_Root."+ver);
- if (u == null) return true; // no cookie: use plain up link
- location = u;
- return false;
-}
-
+// note that this always stores a directory name, ending with a "/"
function SetPLTRoot(ver, relative) {
var root = location.protocol + "//" + location.host
+ NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
SetCookie("PLT_Root."+ver, root);
}
+// adding index.html works because of the above
+function GotoPLTRoot(ver) {
+ var u = GetCookie("PLT_Root."+ver);
+ if (u == null) return true; // no cookie: use plain up link
+ location = u + "index.html";
+ return false;
+}
+
normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
function NormalizePath(path) {
var tmp, i;
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
index ca527787..d629b1ce 100644
--- a/collects/scribble/struct.ss
+++ b/collects/scribble/struct.ss
@@ -172,7 +172,7 @@
[parent (or/c false/c part?)]
[info any/c])]
- [target-url ([addr (or/c string? path?)][style any/c])]
+ [target-url ([addr (or/c string? path?)] [style any/c])]
[url-anchor ([name string?])]
[image-file ([path (or/c path-string?
(cons/c (one-of/c 'collects)