suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix next-links that climb up more than one level

Browse Source 
svn: r10178

original commit: a679c89cb619c9c78f4c3d75d6a220414b042a62
This commit is contained in:
Eli Barzilay 2008-06-06 15:53:42 +00:00
parent 5c1f7ccbbc
commit 316a99fb56
1 changed files with 87 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/scribble/html-render.ss
View File

@ -557,40 +557,39 @@
(define prev-content '(larr " prev")) (define prev-content '(larr " prev"))
(define up-content '("up")) (define up-content '("up"))
(define next-content '("next " rarr)) (define next-content '("next " rarr))
(define no-next-content next-content)
(define sep-element (make-element #f '(nbsp nbsp))) (define sep-element (make-element #f '(nbsp nbsp)))
(define/public (derive-filename d) "bad.html") (define/public (derive-filename d) "bad.html")
(define/private (navigation d ri pre-space?) (define/private (navigation d ri pre-space?)
(let*-values ([(parent) (part-parent d ri)] (define parent (part-parent d ri))
[(prev next) (find-siblings d ri)] (define-values (prev0 next0) (find-siblings d ri))
[(prev) (if prev (define prev
(let loop ([prev prev]) (if prev0
(if (and (toc-part? prev) (let loop ([p prev0])
(pair? (part-parts prev))) (if (and (toc-part? p) (pair? (part-parts p)))
(loop (car (last-pair (part-parts prev)))) (loop (last (part-parts p)))
prev)) p))
(and parent (toc-part? parent) parent))] (and parent (toc-part? parent) parent)))
[(next) (cond [(and (toc-part? d) (define next
(pair? (part-parts d))) (cond [(and (toc-part? d) (pair? (part-parts d))) (car (part-parts d))]
(car (part-parts d))] [(not next0)
[(and (not next) parent (toc-part? parent)) (let loop ([p parent])
(let-values ([(prev next) (and p (toc-part? p)
(find-siblings parent ri)]) (let-values ([(prev next) (find-siblings p ri)])
next)] (or next (loop (part-parent p ri))))))]
[else next])] [else next0]))
[(index) (let loop ([d d]) (define index
(let loop ([d d])
(let ([p (part-parent d ri)]) (let ([p (part-parent d ri)])
(if p (if p
(loop p) (loop p)
(let ([subs (part-parts d)]) (let ([subs (part-parts d)])
(and (pair? subs) (and (pair? subs)
(let ([d (car (last-pair subs))]) (let ([d (last subs)])
(and (part-style? d 'index) (and (part-style? d 'index)
d)))))))]) d))))))))
(define (render . content) (define (render . content) (render-content content d ri))
(render-content content d ri))
(if (not (or prev next parent index up-path)) (if (not (or prev next parent index up-path))
null null
`(,@(if pre-space? '((p nbsp)) null) `(,@(if pre-space? '((p nbsp)) null)
@ -618,8 +617,7 @@
,@(render ,@(render
(make-element (make-element
(if parent (if parent
(make-target-url (make-target-url (if prev (derive-filename prev) "index.html")
(if prev (derive-filename prev) "index.html")
#f) #f)
"nonavigation") "nonavigation")
prev-content) prev-content)
@ -628,14 +626,13 @@
(cond (cond
;; up-path = #t => go up to the start page, using ;; up-path = #t => go up to the start page, using
;; cookies to get to the user's version of it (see ;; cookies to get to the user's version of it (see
;; scribblings/main/private/utils for the code ;; scribblings/main/private/utils for the code that
;; that creates these cookies.) ;; creates these cookies.)
[(and (eq? #t up-path) (not parent)) [(and (eq? #t up-path) (not parent))
(make-target-url (make-target-url
"../index.html" "../index.html"
(make-with-attributes (make-with-attributes
#f `([onclick #f `([onclick . ,(format "return GotoPLTRoot(\"~a\");"
. ,(format "return GotoPLTRoot(\"~a\");"
(version))])))] (version))])))]
[(or parent up-path) [(or parent up-path)
(make-target-url (make-target-url
@ -647,12 +644,11 @@
[else "nonavigation"]) [else "nonavigation"])
up-content) up-content)
sep-element sep-element
(make-element (make-element (if next
(if next
(make-target-url (derive-filename next) #f) (make-target-url (derive-filename next) #f)
"nonavigation") "nonavigation")
next-content))) next-content)))
(p nbsp))))) (p nbsp))))
(define/override (render-one d ri fn) (define/override (render-one d ri fn)
(render-one-part d ri fn null)) (render-one-part d ri fn null))