DrRacket: if any file in package X is open, treat X as "in development"

... for the purpose of "populate 'compiled' directories" --- but only if
the user has write permission for the package directory.

This change may or may not be a good idea. The idea is that installed
packages generally should be treated in the same way as the main
"collects" tree (e.g., avoiding debugging instrumentation), but if you
happen to be developing a package, then you want it treated like things
that are not in the main "collects" tree. So, how do you pick? Maybe
opening a file in the package is a good way to pick.

collects/drracket/private/eval-helpers.rkt

@@ -2,6 +2,7 @@
 (require racket/class
          racket/draw
          racket/list
+         racket/set
          compiler/cm
          setup/dirs
          planet/config
@@ -55,7 +56,9 @@
   #;(namespace-attach-module orig-namespace ''#%foreign))
   
 
-(define (set-module-language-parameters settings module-language-parallel-lock-client
+(define (set-module-language-parameters settings 
+                                        module-language-parallel-lock-client
+                                        currently-open-files
                                         #:use-use-current-security-guard? [use-current-security-guard? #f])
   (current-command-line-arguments (prefab-module-settings-command-line-args settings))
   (let* ([default (current-library-collection-paths)]
@@ -68,6 +71,16 @@
   (compile-context-preservation-enabled (prefab-module-settings-full-trace? settings))
   
   (when (prefab-module-settings-compilation-on? settings)
+    (define open-pkgs
+      (for/fold ([s (set)]) ([path (in-list currently-open-files)])
+        (define pkg (path->pkg path))
+        (if (and pkg
+                 (memq 'write
+                       (file-or-directory-permissions (pkg-directory pkg))))
+            (set-add s pkg)
+            s)))
+    (for ([pkg (in-set open-pkgs)])
+      (log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg))
     (define skip-path?
       (let* ([cd (find-collects-dir)]
              [no-dirs (if cd 
@@ -76,6 +89,7 @@
         (λ (p) (or (file-stamp-in-paths p no-dirs)
                    (let ([pkg (path->pkg p)])
                      (and pkg
+                          (not (set-member? open-pkgs pkg))
                           (file-stamp-in-paths p (list (pkg-directory pkg)))))))))
     (define extra-compiled-file-path
       (case (prefab-module-settings-annotations settings)

collects/drracket/private/expanding-place.rkt

@@ -62,6 +62,7 @@
            (define response-pc (vector-ref message 2))
            (define settings (vector-ref message 3))
            (define pc-status-expanding-place (vector-ref message 4))
+           (define currently-open-files (vector-ref message 5))
            (loop (new-job program-as-string path response-pc settings pc-status-expanding-place)
                  old-registry)]))))))
 
@@ -120,6 +121,7 @@
          (ep-log-info "expanding-place.rkt: 03 setting module language parameters")
          (set-module-language-parameters settings
                                          module-language-parallel-lock-client
+                                         null
                                          #:use-use-current-security-guard? #t)
          (ep-log-info "expanding-place.rkt: 04 setting directories")
          (let ([init-dir (get-init-dir path)])

collects/drracket/private/module-language.rkt

@@ -331,10 +331,12 @@
         (set! language-info #f)
         (set! sandbox #f)
         
+        (let ([currently-open-files (get-currently-open-files)])
           (run-in-user-thread
            (λ ()
               (set-module-language-parameters (module-language-settings->prefab-module-settings settings)
-                                           module-language-parallel-lock-client))))
+                                              module-language-parallel-lock-client
+                                              currently-open-files)))))
       
       (define/override (get-one-line-summary)
         (string-constant module-language-one-line-summary))
@@ -1931,7 +1933,8 @@
                         filename/loc
                         (module-language-settings->prefab-module-settings settings)
                         (λ (res) (oc-finished res))
-                        (λ (a b) (oc-status-message a b)))]
+                        (λ (a b) (oc-status-message a b))
+                        (get-currently-open-files))]
         [else
          (line-of-interest)
          (send dirty/pending-tab set-oc-status
@@ -2009,7 +2012,8 @@
                          filename 
                          prefab-module-settings 
                          show-results 
-                         tell-the-tab-show-bkg-running)
+                         tell-the-tab-show-bkg-running
+                         currently-open-files)
     (unless expanding-place
       (set! expanding-place (dynamic-place expanding-place.rkt 'start))
       (place-channel-put expanding-place module-language-compile-lock)
@@ -2028,7 +2032,8 @@
                                    filename
                                    pc-in 
                                    prefab-module-settings
-                                   pc-status-expanding-place))
+                                   pc-status-expanding-place
+                                   currently-open-files))
                (place-channel-put expanding-place to-send)
                (define us (current-thread))
                (thread (λ () 
@@ -2340,4 +2345,13 @@
        (connect-to-prefs other-choice 'drracket:online-expansion:other-errors)
        (for ([f (in-list (drracket:module-language-tools:get-online-expansion-pref-funcs))])
          (f vp))
-       parent-vp))))
+       parent-vp)))
+  
+  (define (get-currently-open-files)
+    (for*/list ([frame (in-list
+                        (send (group:get-the-frame-group) get-frames))]
+                #:when (frame . is-a? . drracket:unit:frame%)
+                [tab (in-list (send frame get-tabs))]
+                [v (in-value (send (send tab get-defs) get-filename))]
+                #:when v)
+      v)))

collects/tests/drracket/populate-compiled.rkt

@@ -69,7 +69,8 @@
            racket/gui/base
            racket/class
            racket/path
-           racket/file)
+           racket/file
+           framework/test)
 
   (define (check-compiled compiled? path)
     (unless (equal? compiled? (file-exists? path))
@@ -88,10 +89,12 @@
 
         (define popcomp-main-zo
           (build-path dir "popcomp-pkg" "popcomp" "compiled" "drracket" "errortrace" "main_rkt.zo"))
+        (define popcomp2-main-zo
+          (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo"))
 
         (check-compiled #t (build-path dir "compiled" "drracket" "errortrace" "y_rkt.zo"))
         (check-compiled #f popcomp-main-zo)
-        (check-compiled #f (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo"))
+        (check-compiled #f popcomp2-main-zo)
 
         ;; Create a broken ".zo" file where it should not be used:
         (make-directory* (path-only popcomp-main-zo))
@@ -103,4 +106,34 @@
         (do-execute drs)
         (let* ([got (fetch-output drs)])
           (unless (string=? "" got)
-            (error 'check-output "wrong output: ~s" got)))))))
+            (error 'check-output "wrong output: ~s" got)))
+
+        (delete-file popcomp-main-zo)
+
+        ;; Open "main.rkt" in "popcomp-pkg", so now it should be compiled
+        ;; when we run "x.rkt":
+
+        (test:menu-select "File" "New Tab")
+        (use-get/put-dialog (λ () 
+                               (test:menu-select "File" "Open..."))
+                            (build-path dir "popcomp-pkg" "popcomp" "main.rkt"))
+
+        (queue-callback/res (λ () (send drs change-to-tab (car (send drs get-tabs)))))
+
+        (do-execute drs)
+
+        (check-compiled #t popcomp-main-zo)
+        (check-compiled #f popcomp2-main-zo)
+
+        ;; But if the "popcomp-pkg" directory is not writable, then
+        ;; don't compile after all:
+
+        (delete-file popcomp-main-zo)
+        (file-or-directory-permissions (build-path dir "popcomp-pkg") #o555)
+        
+        (do-execute drs)
+
+        (check-compiled #f popcomp-main-zo)
+        (check-compiled #f popcomp2-main-zo)
+
+        (file-or-directory-permissions (build-path dir "popcomp-pkg") #o777)))))