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 p-in? (in-plt? e-p))
(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
;; going in (or if d is #f)
(if (not (and d (cond
@ -2025,7 +2026,10 @@
[d-in? (error 'from-root
"got a link from the PLT tree going out; ~e"
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)
(let loop ([e-d e-d] [e-p e-p])
(cond
@ -2033,11 +2037,11 @@
(string-append*
(let loop ([e-p 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? 'up (car e-p)) (cons "../" (loop (cdr e-p)))]
[else (cons (path->string (car e-p)) (cons "/" (loop (cdr e-p))))])))]
[(equal? (car e-d) (car e-p)) (loop (cdr e-d) (cdr e-p))]
[else (cons (path-element->string (car e-p)) (cons "/" (loop (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-p)) (loop e-d (cdr e-p))]
[else (string-append (string-append* (map (lambda (x) "../") e-d))