up links in all documents, and they go to the user docs using cookies

svn: r9992

original commit: 9127cdaaf832b8bab1353eecbfc47d5e7fe96fe4
This commit is contained in:
Eli Barzilay 2008-05-28 00:02:25 +00:00
parent ef294e47b4
commit 584258ff25
3 changed files with 54 additions and 37 deletions

View File

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

View File

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

View File

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