pkg/lib: make pkg-directory->additional-installs recognize root docs

Merge to v6.1
(cherry picked from commit bc832a680b)
This commit is contained in:
Matthew Flatt 2014-07-15 15:34:07 +01:00 committed by Ryan Culpepper
parent 88bf95297e
commit f5b73656a0

View File

@ -3270,13 +3270,23 @@
#:when (and (list? doc) #:when (and (list? doc)
(pair? doc) (pair? doc)
(path-string? (car doc)) (path-string? (car doc))
(or ((length doc) . < . 2)
(list? (cadr doc)))
(or ((length doc) . < . 4) (or ((length doc) . < . 4)
(collection-name-element? (list-ref doc 3))))) (collection-name-element? (list-ref doc 3)))))
(cons 'doc (string-foldcase (define flags (if ((length doc) . < . 2)
(if ((length doc) . < . 4) null
(let-values ([(base name dir?) (split-path (car doc))]) (cadr doc)))
(path->string (path-replace-suffix name #""))) (cond
(list-ref doc 3))))))) [(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 (extract-paths i tag keys)
(define (get k) (define (get k)
(define l (i k (lambda () null))) (define l (i k (lambda () null)))