From 853e47f05e6feaaa4d29662d2b5a2042a2bea30a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 21 Aug 2011 21:20:15 -0600 Subject: [PATCH] fix broken-link reporting by `scribble' --- collects/scribble/base-render.rkt | 12 ++++++++- collects/scribble/core.rkt | 21 +++++++++------ collects/scribblings/scribble/renderer.scrbl | 27 ++++++++++++++++++++ collects/setup/scribble.rkt | 6 +++-- 4 files changed, 55 insertions(+), 11 deletions(-) diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt index 8b456965bb..eb0cc7829d 100644 --- a/collects/scribble/base-render.rkt +++ b/collects/scribble/base-render.rkt @@ -236,9 +236,19 @@ (define/public (get-defined ci) (hash-map (collect-info-ht ci) (lambda (k v) k))) - (define/public (get-undefined ri) + (define/public (get-external ri) (hash-map (resolve-info-undef ri) (lambda (k v) k))) + (define/public (get-undefined ri) + (for/list ([(k v) (in-hash (resolve-info-undef ri))] + #:unless (or (eq? v 'found) + (and v + ;; v is a search key; see if any key in the set was resolved: + (let ([ht (hash-ref (resolve-info-searches ri) v)]) + (for/or ([k2 (in-hash-keys ht)]) + (eq? 'found (hash-ref (resolve-info-undef ri) k2 #f))))))) + k)) + (define/public (transfer-info ci src-ci) (let ([in-ht (collect-info-ext-ht ci)]) (for ([(k v) (collect-info-ext-ht src-ci)]) diff --git a/collects/scribble/core.rkt b/collects/scribble/core.rkt index 4058b5ee0b..aa88460147 100644 --- a/collects/scribble/core.rkt +++ b/collects/scribble/core.rkt @@ -39,13 +39,20 @@ #t)])))) (define (resolve-get/ext? part ri key) + (resolve-get/ext?* part ri key #f)) + +(define (resolve-get/ext?* part ri key search-key) (let-values ([(v ext?) (resolve-get/where part ri key)]) (when ext? - (hash-set! (resolve-info-undef ri) (tag-key key ri) #t)) + (hash-set! (resolve-info-undef ri) (tag-key key ri) + (if v 'found search-key))) (values v ext?))) (define (resolve-get part ri key) - (let-values ([(v ext?) (resolve-get/ext? part ri key)]) + (resolve-get* part ri key #f)) + +(define (resolve-get* part ri key search-key) + (let-values ([(v ext?) (resolve-get/ext?* part ri key search-key)]) v)) (define (resolve-get/tentative part ri key) @@ -61,14 +68,12 @@ search-key s-ht) s-ht)))]) (hash-set! s-ht key #t)) - (resolve-get part ri key)) + (resolve-get* part ri key search-key)) (define (resolve-get-keys part ri key-pred) - (let ([l null]) - (hash-for-each - (collected-info-info (part-collected-info part ri)) - (lambda (k v) (when (key-pred k) (set! l (cons k l))))) - l)) + (for/list ([k (in-hash-keys (collected-info-info (part-collected-info part ri)))] + #:when (key-pred k)) + k)) (provide (struct-out collect-info) (struct-out resolve-info)) diff --git a/collects/scribblings/scribble/renderer.scrbl b/collects/scribblings/scribble/renderer.scrbl index 6fad20de9c..2b59580fa2 100644 --- a/collects/scribblings/scribble/renderer.scrbl +++ b/collects/scribblings/scribble/renderer.scrbl @@ -187,6 +187,7 @@ object.} Serializes the collected info in @racket[ri].} + @defmethod[(deserialize-info [v any/c] [ci collect-info?] [#:root root-path (or/c path-string? false/c) #f]) @@ -199,6 +200,32 @@ recorded in @racket[ci] as relative to an instantiation-supplied @racket[root-path] are deserialized as relative instead to the given @racket[root-path].} + +@defmethod[(get-defined [ci collect-info?]) (listof tag?)]{ + +Returns a list of tags that were defined within the documents +represented by @racket[ci].} + + +@defmethod[(get-external [ri resolve-info?]) (listof tag?)]{ + +Returns a list of tags that were referenced but not defined within the +documents represented by @racket[ri] (though possibly found in +cross-reference information transferred to @racket[ri] via +@racket[xref-transfer-info]).} + + +@defmethod[(get-undefined [ri resolve-info?]) (listof tag?)]{ + +Returns a list of tags that were referenced by the resolved documents +with no target found either in the resolved documents represented by +@racket[ri] or cross-reference information transferred to @racket[ri] +via @racket[xref-transfer-info]. + +If multiple tags were referenced via @racket[resolve-search] and a +target was found for any of the tags using the same dependency key, +then no tag in the set is included in the list of undefined tags.} + } @; ---------------------------------------- diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt index 6cd84353ca..c19124364d 100644 --- a/collects/setup/scribble.rkt +++ b/collects/setup/scribble.rkt @@ -265,6 +265,8 @@ (doc-src-file (info-doc i)))) (hash-set! deps i #t))) (when first? + ;; FIXME: instead of special-casing 'dep, we should + ;; skip any key that is covered by `(info-searches info)'. (unless (eq? (car k) 'dep) (not-found k)))))) (when first? @@ -627,7 +629,7 @@ v)))] [sci (send renderer serialize-info ri)] [defs (send renderer get-defined ci)] - [undef (send renderer get-undefined ri)] + [undef (send renderer get-external ri)] [searches (resolve-info-searches ri)] [need-out-write? (or (not out-v) @@ -753,7 +755,7 @@ (render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci)))] [sci (render-time "serialize" (send renderer serialize-info ri))] [defs (render-time "defined" (send renderer get-defined ci))] - [undef (render-time "undefined" (send renderer get-undefined ri))] + [undef (render-time "undefined" (send renderer get-external ri))] [in-delta? (not (equal? (any-order undef) (any-order ff-undef)))] [out-delta? (or (not (serialized=? sci ff-sci)) (not (equal? (any-order defs) (any-order ff-provides))))])