From f5b73656a0038742a04b967afb953da0f2904648 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 15 Jul 2014 15:34:07 +0100 Subject: [PATCH] pkg/lib: make `pkg-directory->additional-installs` recognize root docs Merge to v6.1 (cherry picked from commit bc832a680bb68cac863a42741db7ef4ba13c1a77) --- racket/collects/pkg/lib.rkt | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 9c5fdb9f98..58329c0991 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -3270,13 +3270,23 @@ #:when (and (list? doc) (pair? doc) (path-string? (car doc)) + (or ((length doc) . < . 2) + (list? (cadr doc))) (or ((length doc) . < . 4) (collection-name-element? (list-ref doc 3))))) - (cons 'doc (string-foldcase - (if ((length doc) . < . 4) - (let-values ([(base name dir?) (split-path (car doc))]) - (path->string (path-replace-suffix name #""))) - (list-ref doc 3))))))) + (define flags (if ((length doc) . < . 2) + null + (cadr doc))) + (cond + [(member 'main-doc-root flags) '(main-doc-root . "root")] + [(member 'user-doc-root flags) '(user-doc-root . "root")] + [else + (cons 'doc + (string-foldcase + (if ((length doc) . < . 4) + (let-values ([(base name dir?) (split-path (car doc))]) + (path->string (path-replace-suffix name #""))) + (list-ref doc 3))))])))) (define (extract-paths i tag keys) (define (get k) (define l (i k (lambda () null)))