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

HTML output: fix relative-path computation for Windows drives

Browse Source 
The relative-path computation assumed that a relative path was
always possible, but a relative path can't go from one drive
to another.

Also, the relative-path computation didn't take into account
case-insensitivity, so it failed in a different-drive way
when the drive case was different between two paths.

Closes racket/racket#1625
This commit is contained in:
Matthew Flatt 2017-03-24 19:57:27 -06:00
parent a26a7322a5
commit 5c7c8a3bd0
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
scribble-lib/scribble/html-render.rkt
View File

@ -2018,6 +2018,7 @@
(define e-d (and d (explode (path->complete-path d)))) (define e-d (and d (explode (path->complete-path d))))
(define p-in? (in-plt? e-p)) (define p-in? (in-plt? e-p))
(define d-in? (and d (in-plt? e-d))) (define d-in? (and d (in-plt? e-d)))
(define (normalize p) (normal-case-path p))
;; use an absolute link if the link is from outside the plt tree ;; use an absolute link if the link is from outside the plt tree
;; going in (or if d is #f) ;; going in (or if d is #f)
(if (not (and d (cond (if (not (and d (cond
@ -2025,7 +2026,10 @@
[d-in? (error 'from-root [d-in? (error 'from-root
"got a link from the PLT tree going out; ~e" "got a link from the PLT tree going out; ~e"
p)] p)]
[else #f]))) [else #f])
;; On Windows, need to be on the same drive, at least:
(equal? (normalize (car e-d))
(normalize (car e-p)))))
(path->url-string c-p) (path->url-string c-p)
(let loop ([e-d e-d] [e-p e-p]) (let loop ([e-d e-d] [e-p e-p])
(cond (cond
@ -2033,11 +2037,11 @@
(string-append* (string-append*
(let loop ([e-p e-p]) (let loop ([e-p e-p])
(cond [(null? e-p) '("/")] (cond [(null? e-p) '("/")]
[(null? (cdr e-p)) (list (path->string (car e-p)))] [(null? (cdr e-p)) (list (path-element->string (car e-p)))]
[(eq? 'same (car e-p)) (loop (cdr e-p))] [(eq? 'same (car e-p)) (loop (cdr e-p))]
[(eq? 'up (car e-p)) (cons "../" (loop (cdr e-p)))] [(eq? 'up (car e-p)) (cons "../" (loop (cdr e-p)))]
[else (cons (path->string (car e-p)) (cons "/" (loop (cdr e-p))))])))] [else (cons (path-element->string (car e-p)) (cons "/" (loop (cdr e-p))))])))]
[(equal? (car e-d) (car e-p)) (loop (cdr e-d) (cdr e-p))] [(equal? (normalize (car e-d)) (normalize (car e-p))) (loop (cdr e-d) (cdr e-p))]
[(eq? 'same (car e-d)) (loop (cdr e-d) e-p)] [(eq? 'same (car e-d)) (loop (cdr e-d) e-p)]
[(eq? 'same (car e-p)) (loop e-d (cdr e-p))] [(eq? 'same (car e-p)) (loop e-d (cdr e-p))]
[else (string-append (string-append* (map (lambda (x) "../") e-d)) [else (string-append (string-append* (map (lambda (x) "../") e-d))