From 7dd9a13ad63da534a8f5078e633ad934b14cac7c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 18 Apr 2014 14:52:32 -0600 Subject: [PATCH] fix references to subdirectories of a rendered manual For example, fix the resolution of a link to a binding in the R5RS or R6RS spec. original commit: 4216f3b66615ed5f63ff2f8350e9e1f778cd141b --- .../scribble-lib/scribble/html-render.rkt | 23 +++++++++++++++---- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 10125a66..b2a2a79f 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -508,13 +508,26 @@ (anchor-name (dest-anchor dest)))))) "???")) - (define/private (dest->url-in-doc dest) + (define/private (dest->url-in-doc dest ext-id) (and dest (not (dest-redirect dest)) (format "~a~a~a" - (let-values ([(base name dir?) (split-path - (relative->path (dest-path dest)))]) - name) + ;; The path within the document directory is normally + ;; just a single element, but detect nested paths + ;; (for "r5rs-std", for example) when the containing + ;; directory doesn't match `ext-id`: + (let loop ([path (relative->path (dest-path dest))] + [empty-ok? #f]) + (let-values ([(base name dir?) (split-path path)]) + (cond + [(and empty-ok? + dir? + (equal? (format "~a" name) (format "~a" ext-id))) + #f] + [(path? base) + (define r (loop base #t)) + (if r (build-path r name) name)] + [else name]))) (if (dest-page? dest) "" "#") (if (dest-page? dest) "" @@ -1294,7 +1307,7 @@ [query (if (string? ext-id) (list* (cons 'doc ext-id) - (cons 'rel (or (dest->url-in-doc dest) "???")) + (cons 'rel (or (dest->url-in-doc dest ext-id) "???")) (url-query u)) (cons (cons 'tag (tag->query-string (link-element-tag e))) (url-query u)))])))]