Revert "avoid calling pkg->path from DrRacket's manager-skip-file-handler"
The reverted commit assumed that all pkgs were in either (get-pkgs-search-dirs)
or (find-user-pkgs-dir), which is a bogus assumption
This reverts commit b600dcc7bc
.
This commit is contained in:
parent
b600dcc7bc
commit
1effcac706
|
@ -3,7 +3,6 @@
|
||||||
racket/draw
|
racket/draw
|
||||||
racket/list
|
racket/list
|
||||||
racket/set
|
racket/set
|
||||||
racket/path
|
|
||||||
compiler/cm
|
compiler/cm
|
||||||
setup/dirs
|
setup/dirs
|
||||||
planet/config
|
planet/config
|
||||||
|
@ -74,44 +73,28 @@
|
||||||
(compile-enforce-module-constants (prefab-module-settings-enforce-module-constants settings))
|
(compile-enforce-module-constants (prefab-module-settings-enforce-module-constants settings))
|
||||||
(define path->pkg-cache (make-hash))
|
(define path->pkg-cache (make-hash))
|
||||||
(when (prefab-module-settings-compilation-on? settings)
|
(when (prefab-module-settings-compilation-on? settings)
|
||||||
(define-values (open-pkg-exploded-dirs open-pkgs)
|
(define open-pkgs
|
||||||
(for/fold ([exploded-dirs (set)] [pkgs (set)]) ([path (in-list currently-open-files)])
|
(for/fold ([s (set)]) ([path (in-list currently-open-files)])
|
||||||
(define pkg (path->pkg path #:cache path->pkg-cache))
|
(define pkg (path->pkg path #:cache path->pkg-cache))
|
||||||
(cond
|
(if (and pkg
|
||||||
[pkg
|
(memq 'write
|
||||||
(define dir (pkg-directory pkg))
|
(file-or-directory-permissions (pkg-directory pkg))))
|
||||||
(if (memq 'write
|
(set-add s pkg)
|
||||||
(file-or-directory-permissions dir))
|
s)))
|
||||||
(values (set-add exploded-dirs (explode-path (simple-form-path dir)))
|
|
||||||
(set-add pkgs pkg))
|
|
||||||
(values exploded-dirs pkgs))]
|
|
||||||
[else (values exploded-dirs pkgs)])))
|
|
||||||
(for ([pkg (in-set open-pkgs)])
|
(for ([pkg (in-set open-pkgs)])
|
||||||
(log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg))
|
(log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg))
|
||||||
(define (in-open-pkg? p)
|
|
||||||
(cond
|
|
||||||
[(set-empty? open-pkg-exploded-dirs) #f]
|
|
||||||
[else
|
|
||||||
(define exp-p (explode-path (simple-form-path p)))
|
|
||||||
(define exp-p-len (length exp-p))
|
|
||||||
(for/or ([exploded-dir (in-set open-pkg-exploded-dirs)])
|
|
||||||
(and (<= (length exploded-dir) exp-p-len)
|
|
||||||
(for/and ([pkg-ele (in-list exploded-dir)]
|
|
||||||
[p-ele (in-list exp-p)])
|
|
||||||
(equal? pkg-ele p-ele))))]))
|
|
||||||
(define skip-path?
|
(define skip-path?
|
||||||
(let* ([cd (find-collects-dir)]
|
(let* ([cd (find-collects-dir)]
|
||||||
[sd (find-share-dir)]
|
[sd (find-share-dir)]
|
||||||
[no-dirs (append
|
[no-dirs (append
|
||||||
(list (CACHE-DIR)
|
(list (CACHE-DIR))
|
||||||
(find-user-pkgs-dir))
|
|
||||||
(if cd (list cd) null)
|
(if cd (list cd) null)
|
||||||
(if sd (list sd) null)
|
(if sd (list sd) null))])
|
||||||
(filter directory-exists?
|
(λ (p) (or (file-stamp-in-paths p no-dirs)
|
||||||
(get-pkgs-search-dirs)))])
|
(let ([pkg (path->pkg p #:cache path->pkg-cache)])
|
||||||
(λ (p)
|
(and pkg
|
||||||
(and (not (in-open-pkg? p))
|
(not (set-member? open-pkgs pkg))
|
||||||
(file-stamp-in-paths p no-dirs)))))
|
(file-stamp-in-paths p (list (pkg-directory pkg)))))))))
|
||||||
(define extra-compiled-file-path
|
(define extra-compiled-file-path
|
||||||
(case (prefab-module-settings-annotations settings)
|
(case (prefab-module-settings-annotations settings)
|
||||||
[(none) (build-path "compiled" "drracket")]
|
[(none) (build-path "compiled" "drracket")]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user