diff --git a/collects/compiler/cm.ss b/collects/compiler/cm.ss index f5c8321ec4..aecd9aa8ea 100644 --- a/collects/compiler/cm.ss +++ b/collects/compiler/cm.ss @@ -13,6 +13,7 @@ manager-compile-notify-handler manager-skip-file-handler file-date-in-collection + file-date-in-paths (rename-out [trace manager-trace-handler])) (define manager-compile-notify-handler (make-parameter void)) @@ -22,12 +23,15 @@ (define manager-skip-file-handler (make-parameter (λ (x) #f))) (define (file-date-in-collection p) + (file-date-in-paths p (current-library-collection-paths))) + +(define (file-date-in-paths p paths) (let ([p-eles (explode-path (simplify-path p))]) - (let c-loop ([collects-paths (current-library-collection-paths)]) + (let c-loop ([paths paths]) (cond - [(null? collects-paths) #f] + [(null? paths) #f] [else - (let i-loop ([collects-eles (explode-path (car collects-paths))] + (let i-loop ([collects-eles (explode-path (car paths))] [p-eles p-eles]) (cond [(null? collects-eles) @@ -60,13 +64,13 @@ (file-or-directory-modify-seconds p)])))] [(null? p-eles) ;; this case shouldn't happen... I think. - (c-loop (cdr collects-paths))] + (c-loop (cdr paths))] [else (cond [(equal? (car p-eles) (car collects-eles)) (i-loop (cdr collects-eles) (cdr p-eles))] [else - (c-loop (cdr collects-paths))])]))])))) + (c-loop (cdr paths))])]))])))) (define (trace-printf fmt . args) (let ([t (trace)]) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index e550325243..90f11ea4d3 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -5,15 +5,16 @@ scheme/class scheme/list scheme/path + scheme/contract mred compiler/embed compiler/cm launcher framework string-constants + planet/config "drsig.ss" - "rep.ss" - scheme/contract) + "rep.ss") (define op (current-output-port)) (define (oprintf . args) (apply fprintf op args)) @@ -184,7 +185,10 @@ (use-compiled-file-paths)))])) (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)) - (manager-skip-file-handler file-date-in-collection))))) + (manager-skip-file-handler + (λ (p) (file-date-in-paths + p + (cons (CACHE-DIR) (current-library-collection-paths))))))))) (define/override (get-one-line-summary) (string-constant module-language-one-line-summary)) diff --git a/collects/scribblings/drscheme/languages.scrbl b/collects/scribblings/drscheme/languages.scrbl index e24d737865..63f10a1808 100644 --- a/collects/scribblings/drscheme/languages.scrbl +++ b/collects/scribblings/drscheme/languages.scrbl @@ -1,7 +1,8 @@ #lang scribble/doc @(require "common.ss" (for-label errortrace/errortrace-lib - compiler/cm)) + compiler/cm + planet/config)) @title[#:tag "languages" #:style 'toc]{Languages} @@ -52,7 +53,11 @@ of various libraries). The @italic{populate compiled/ directories} option corresponds to @schemeblock[(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)) - (manager-skip-file-handler file-date-in-collection)] + (manager-skip-file-handler + (λ (p) + (file-date-in-paths + p + (cons (CACHE-DIR) (current-library-collection-paths)))))] plus adding either @scheme[(build-path "compiled" "drscheme")] or @scheme[(build-path "compiled" "drscheme" "errortrace")] to the front of @scheme[use-compiled-file-paths], depending if the diff --git a/collects/scribblings/mzc/make.scrbl b/collects/scribblings/mzc/make.scrbl index 4c46baa81c..6b1927c5cf 100644 --- a/collects/scribblings/mzc/make.scrbl +++ b/collects/scribblings/mzc/make.scrbl @@ -251,9 +251,14 @@ A parameter whose value is called for each file that is loaded and @scheme[(lambda (x) #f)].} @defproc[(file-date-in-collection [p path?]) (or/c number? #f)]{ + Calls @scheme[file-date-in-paths] with @scheme[p] and + @scheme[(current-library-collection-paths)]. +} + +@defproc[(file-date-in-paths [p path?] [paths (listof path?)]) (or/c number? #f)]{ This is a function intended to be used with @scheme[manager-skip-file-handler]. It returns the date of the @tt{.ss} or @tt{.zo} file (whichever is newer) - for any path that is inside the collection hierarchy and returns + for any path that is inside the @scheme[paths] argument, and @scheme[#f] for any other path. }