Two improvements to the mrlib/graph library and the module browser:

- improved the drawing speed in mrlib's graph pasteboard
  by caching the background arrows (optionally; only turned
  on for the module browser. in redex, this probably won't
  speed anything up so it isn't used)

- added a search feature to the module graph to help find
  dependencies; type in string and some of the graph changes
  color

collects/drracket/private/drsig.rkt

@@ -322,6 +322,7 @@
   ())
 (define-signature drracket:module-overview^ extends drracket:module-overview-cm^
   (module-overview
+   module-overview/file
    make-module-overview-pasteboard
    fill-pasteboard))
 

collects/drracket/private/module-browser.rkt

@@ -62,7 +62,8 @@
       get-word
       get-lines
       is-special-key-child?
-      add-special-key-child))
+      add-special-key-child
+      set-found!))
   
   ;; make-module-overview-pasteboard : boolean
   ;;                                   ((union #f snip) -> void)
@@ -76,7 +77,10 @@
     ;; snip-table : hash-table[sym -o> snip]
     (define snip-table (make-hash))
     (define label-font (find-label-font (preferences:get 'drracket:module-overview:label-font-size)))
-    (define text-color (make-object color% "blue"))
+    (define text-color "blue")
+    
+    (define search-result-text-color "white")
+    (define search-result-background "forestgreen")
     
     (define dark-syntax-pen (send the-pen-list find-or-create-pen "darkorchid" 1 'solid))
     (define dark-syntax-brush (send the-brush-list find-or-create-brush "darkorchid" 'solid))
@@ -512,6 +516,8 @@
                     lines
                     pb)
         
+        (inherit get-admin)
+        
         (define require-phases '())
         (define/public (add-require-phase d)
           (unless (member d require-phases)
@@ -541,8 +547,8 @@
                                       "salmon"
                                       'solid))))
         
-        (field (snip-width 0)
+        (define snip-width 0)
-               (snip-height 0))
+        (define snip-height 0)
         
         (define/override (get-extent dc x y wb hb descent space lspace rspace)
           (cond
@@ -551,8 +557,8 @@
              (set! snip-height 15)]
             [else
              (let-values ([(w h a d) (send dc get-text-extent (name->label) label-font)])
-               (set! snip-width (+ w 4))
+               (set! snip-width (+ w 5))
-               (set! snip-height (+ h 4)))])
+               (set! snip-height (+ h 5)))])
           (set-box/f wb snip-width)
           (set-box/f hb snip-height)
           (set-box/f descent 0)
@@ -560,20 +566,36 @@
           (set-box/f lspace 0)
           (set-box/f rspace 0))
         
+        (define/public (set-found! fh?) 
+          (unless (eq? (and fh? #t) found-highlight?)
+            (set! found-highlight? (and fh? #t))
+            (let ([admin (get-admin)])
+              (when admin
+                (send admin needs-update this 0 0 snip-width snip-height)))))
+        (define found-highlight? #f)
+        
         (define/override (draw dc x y left top right bottom dx dy draw-caret)
           (let ([old-font (send dc get-font)]
                 [old-text-foreground (send dc get-text-foreground)]
-                [old-brush (send dc get-brush)])
+                [old-brush (send dc get-brush)]
+                [old-pen (send dc get-pen)])
             (send dc set-font label-font)
-            (when lines-brush
+            (cond
-              (send dc set-brush lines-brush))
+              [found-highlight?
+               (send dc set-brush search-result-background 'solid)]
+              [lines-brush
+               (send dc set-brush lines-brush)])
             (when (and (or (<= left x right)
                            (<= left (+ x snip-width) right))
                        (or (<= top y bottom)
                            (<= top (+ y snip-height) bottom)))
               (send dc draw-rectangle x y snip-width snip-height)
-              (send dc set-text-foreground text-color)
+              (send dc set-text-foreground (send the-color-database find-color 
+                                                 (if found-highlight?
+                                                     search-result-text-color
+                                                     text-color)))
               (send dc draw-text (name->label) (+ x 2) (+ y 2)))
+            (send dc set-pen old-pen)
             (send dc set-brush old-brush)
             (send dc set-text-foreground old-text-foreground)
             (send dc set-font old-font)))
@@ -626,7 +648,7 @@
     (define draw-lines-pasteboard% (module-overview-pasteboard-mixin
                                     (graph-pasteboard-mixin
                                      pasteboard:basic%)))
-    (make-object draw-lines-pasteboard%))
+    (new draw-lines-pasteboard% [cache-arrow-drawing? #t]))
   
   
   ;                                                                
@@ -648,7 +670,8 @@
   
   
   (define (module-overview/file filename parent)
-    (define progress-frame (parameterize ([current-eventspace (make-eventspace)])
+    (define progress-eventspace (make-eventspace))
+    (define progress-frame (parameterize ([current-eventspace progress-eventspace])
                              (instantiate frame% ()
                                (parent parent)
                                (label progress-label)
@@ -661,8 +684,11 @@
     (define thd 
       (thread
        (λ ()
-         (sleep 3)
+         (sleep 2)
-         (send progress-frame show #t))))
+         (parameterize ([current-eventspace progress-eventspace])
+           (queue-callback
+            (λ ()
+              (send progress-frame show #t)))))))
     
     (define text/pos 
       (let ([t (make-object text:basic%)])
@@ -675,7 +701,10 @@
     (define update-label void)
     
     (define (show-status str)
-      (send progress-message set-label str))
+      (parameterize ([current-eventspace progress-eventspace])
+        (queue-callback
+         (λ ()
+           (send progress-message set-label str)))))
     
     (define pasteboard (make-module-overview-pasteboard 
                         #f
@@ -683,7 +712,10 @@
     
     (let ([success? (fill-pasteboard pasteboard text/pos show-status void)])
       (kill-thread thd)
-      (send progress-frame show #f)
+      (parameterize ([current-eventspace progress-eventspace])
+        (queue-callback
+         (λ ()
+           (send progress-frame show #f))))
       (when success?
         (let ()
           (define frame (instantiate overview-frame% ()
@@ -751,6 +783,23 @@
           
           (define ec (make-object canvas:basic% vp pasteboard))
           
+          (define search-tf
+            (new text-field%
+                 [label (string-constant module-browser-highlight)]
+                 [parent vp]
+                 [callback
+                  (λ (tf evt)
+                    (send pasteboard begin-edit-sequence)
+                    (define val (send tf get-value))
+                    (define reg (and (not (string=? val ""))
+                                     (regexp (regexp-quote (send tf get-value)))))
+                    (let loop ([snip (send pasteboard find-first-snip)])
+                      (when snip
+                        (when (is-a? snip boxed-word-snip<%>)
+                          (send snip set-found! (and reg (regexp-match reg (path->string (send snip get-filename))))))
+                        (loop (send snip next))))
+                    (send pasteboard end-edit-sequence))]))
+          
           (send lib-paths-checkbox set-value (not (memq 'lib (preferences:get 'drracket:module-browser:hide-paths))))
           (set! update-label
                 (λ (s)

collects/drracket/private/unit.rkt

@@ -3722,6 +3722,21 @@ module browser threading seems wrong.
               (string-constant module-browser...)
               language-specific-menu
               (λ (x y) (drracket:module-overview:module-overview this)))
+            (new menu:can-restore-menu-item%
+                 [label (format (string-constant module-browser-in-file) 
+                                (send definitions-text get-filename))]
+                 [parent language-specific-menu]
+                 [demand-callback (λ (i) 
+                                    (define fn (send definitions-text get-filename))
+                                    (send i set-label 
+                                          (if fn
+                                              (format (string-constant module-browser-in-file) fn)
+                                              (string-constant module-browser-no-file)))
+                                    (send i enable fn))]
+                 [callback (λ (x y) 
+                             (define fn (send definitions-text get-filename))
+                             (when fn
+                               (drracket:module-overview:module-overview/file fn this)))])
             (make-object separator-menu-item% language-specific-menu)
             
             (let ([cap-val

collects/mrlib/graph.rkt

@@ -11,6 +11,8 @@
            graph-pasteboard<%>
            graph-pasteboard-mixin)
   
+  (define-local-member-name invalidate-edge-cache)
+  
   (define graph-snip<%>
     (interface ()
       get-children 
@@ -163,7 +165,9 @@
 
   (define graph-snip-mixin
     (mixin ((class->interface snip%)) (graph-snip<%>)
-      (field (children null))
+      (inherit get-admin)
+      
+      (define children null)
       (define/public (get-children) children)
       (define/public (add-child child)
         (unless (memq child children)
@@ -172,7 +176,7 @@
         (when (memq child children)
           (set! children (remq child children))))
       
-      (field (parent-links null))
+      (define parent-links null)
       (define/public (get-parent-links) parent-links)
       (define/public (get-parents) (map link-snip parent-links))
       (define/public add-parent
@@ -184,6 +188,11 @@
            (add-parent parent dark-pen light-pen dark-brush light-brush #f #f dx dy #f)]
           [(parent dark-pen light-pen dark-brush light-brush dark-text light-text dx dy label)
            (unless (memf (lambda (parent-link) (eq? (link-snip parent-link) parent)) parent-links)
+             (define admin (get-admin))
+             (when admin
+               (define ed (send admin get-editor))
+               (when (is-a? ed graph-pasteboard<%>)
+                 (send ed invalidate-edge-cache)))
              (set! parent-links 
                    (cons (make-link parent
                                     (or dark-pen default-dark-pen)
@@ -260,7 +269,8 @@
       (inherit find-first-snip find-next-selected-snip)
       
       (init-field [edge-label-font #f]
-                  [edge-labels? #t])
+                  [edge-labels? #t]
+                  [cache-arrow-drawing? #f])
       
       (define draw-arrow-heads? #t)
       (define flip-labels?      #t)
@@ -524,6 +534,40 @@
         (super on-paint before? dc left top right bottom dx dy draw-caret))
       
       (define/public (draw-edges dc left top right bottom dx dy)
+        (cond
+          [cache-arrow-drawing?
+           (define admin (get-admin))
+           (when admin
+             (define-values (x y w h)
+               (let ([xb (box 0)]
+                     [yb (box 0)]
+                     [wb (box 0)]
+                     [hb (box 0)])
+                 (send admin get-max-view xb yb wb hb)
+                 (values (unbox xb) (unbox yb) (unbox wb) (unbox hb))))
+             (define this-time (list x y w h))
+             (unless (and edges-cache (equal? this-time edges-cache-last-time))
+               (set! edges-cache-last-time this-time)
+               (set! edges-cache (make-bitmap (inexact->exact (ceiling w))
+                                              (inexact->exact (ceiling h))))
+               (define bdc (make-object bitmap-dc% edges-cache))
+               (draw-edges/compute bdc x y (+ x w) (+ y h) dx dy #f)
+               (send bdc set-bitmap #f))
+             (send dc draw-bitmap edges-cache 0 0)
+             (draw-edges/compute dc left top right bottom dx dy #t))]
+          [else 
+           (draw-edges/compute dc left top right bottom dx dy #f)
+           (draw-edges/compute dc left top right bottom dx dy #t)]))
+      
+      (define/augment (on-change)
+        (set! edges-cache #f)
+        (inner (void) on-change))
+      
+      (define/public (invalidate-edge-cache) (set! edges-cache #f))
+      (define edges-cache #f)
+      (define edges-cache-last-time #f)
+        
+      (define/private (draw-edges/compute dc left top right bottom dx dy draw-dark-lines?)
           ;; draw-connection : link snip boolean boolean -> void
           ;; sets the drawing context (pen and brush)
           ;; determines if the connection is between a snip and itself or two different snips
@@ -681,12 +725,12 @@
                left top right bottom 
                (lambda (from-link to)
                  (let ([from (link-snip from-link)])
-                   (cond
+                   (when (and (or (memq from currently-overs)
-                     [(or (memq from currently-overs)
+                                  (memq to currently-overs))
-                          (memq to currently-overs))
+                              draw-dark-lines?)
-                      (set! pairs (cons (cons from-link to) pairs))]
+                     (set! pairs (cons (cons from-link to) pairs)))
-                     [else
+                   (unless draw-dark-lines?
-                      (draw-connection from-link to #f)]))))
+                     (draw-connection from-link to #f)))))
               (for-each (lambda (pr)
                           (draw-connection (car pr) (cdr pr) #t))
                         pairs))

collects/mrlib/scribblings/graph/graph-pasteboard-mixin.scrbl

@@ -4,7 +4,8 @@
 @defmixin/title[graph-pasteboard-mixin (pasteboard%) (graph-pasteboard<%>)]{
 
 @defconstructor/auto-super[([edge-labels? boolean? #t]
-                            [edge-label-font (or/c #f (is-a?/c font%)) #f])]{
+                            [edge-label-font (or/c #f (is-a?/c font%)) #f]
+                            [cache-arrow-drawing? any])]{
 
 If @scheme[edge-labels?] is @scheme[#f], no edge labels are
 drawn. Otherwise, they are.
@@ -13,6 +14,10 @@ If @scheme[edge-label-font] is supplied, it is used when drawing the
 labels on the edges. Otherwise, the font is not set before drawing
 the labels, defaulting to the @scheme[dc<%>] object's font.
 
+If @racket[cache-arrow-drawing?] is @racket[#f], then the arrows in the snip
+are not cached in a bitmap (to speed up drawing when the mouse moves around).
+Otherwise, they are.
+
 }
 
 This mixin overrides many methods to draw lines between

collects/scribblings/drracket/interface-essentials.scrbl

@@ -711,8 +711,9 @@ file cannot be included in another debugging session.
 @section[#:tag "module-browser"]{The Module Browser}
 
 The module browser shows you the structure of all of the files in your program.
-It can be opened via the @onscreen{Show} menu, or via the @onscreen{Module Browser ...} 
+It can be opened via the @onscreen{Show} menu, or via the 
-menu item in the @onscreen{Racket} menu.
+@onscreen{Module Browser} 
+menu items in the @onscreen{Racket} menu.
 
 A module browser window contains a square for each
   module. The squares are colored based on the number of
@@ -726,13 +727,18 @@ A module browser window contains a square for each
   right, but since modules can be moved around
   interactively, that property might not be preserved.
 
-  To open the file corresponding to the module, right-click or
+  To open the file corresponding to the module, double click
-  control-click (Mac OS X) on the box for that module.
+  on the box for that module.
   
   The module browser will also show you the phases that each
   module is loaded in; choose the ``Long, with phases'' menu item
   in the ``Names'' pop-up menu. The integers indicate the phases and
   if @racket[#f] is present, it means the module is loaded @racket[for-label].
+  
+  The bar along the bottom helps you find your way in a module graph. Specifically,
+  if you type something there, then all of the modules whose filenames match
+  what you type will turn green in the module window. This bar is only visible
+  in the stand alone module browser window (via the @onscreen{Racket} menu)
 
 @section[#:tag "create-exe"]{Creating Executables}
 

collects/scribblings/drracket/menus.scrbl

@@ -303,12 +303,21 @@ portions of the program.}
    info.}
 
 @item{@defmenuitem{Module Browser...} Prompts for a file and
-  then opens a window showing the module import structure
+  then opens a window showing the module 
-  for the module import DAG starting at the selected module.
+  DAG starting at the module in the selected file.
   
   See also @secref["module-browser"].
   }
 
+@item{@defmenuitem{Module Browser on @italic{file}} 
+       Opens a separate window showing the module graph rooted at the
+       file currently being edited in DrRacket, but
+       using the saved file on the disk, instead of the 
+       version in DrRacket.
+       
+  See also @secref["module-browser"].
+  }
+
  @item{@defmenuitem{Reindent} Indents the selected text according to
   the standard Racket formatting conventions. (Pressing the Tab key
   has the same effect.)}

collects/string-constants/english-string-constants.rkt

@@ -1229,6 +1229,8 @@ please adhere to these guidelines:
  (module-browser-open-file-format "Open ~a")
  (module-browser "Module Browser") ;; frame title
  (module-browser... "&Module Browser...") ;; menu item title
+ (module-browser-in-file "M&odule Browser on ~a") ;; menu item title; ~a is filled with a filename
+ (module-browser-no-file "Module Browser on This Saved File") ;; menu item title for above menu item; used when there is no saved file
  (module-browser-error-expanding "Error expanding the program:\n\n~a")
  (module-browser-show-lib-paths "Show files loaded by (lib ..) paths")
  (module-browser-progress "Module Browser: ~a") ;; prefix in the status line
@@ -1236,7 +1238,8 @@ please adhere to these guidelines:
  (module-browser-show-lib-paths/short "Follow lib requires") ;; check box label in show module browser pane in drscheme window.
  (module-browser-show-planet-paths/short "Follow PLaneT requires") ;; check box label in show module browser pane in drscheme window.
  (module-browser-refresh "Refresh") ;; button label in show module browser pane in drscheme window.
- (module-browser-only-in-plt-and-module-langs
+ (module-browser-highlight "Highlight") ;; used to search in the graph; the label on a text-field% object
+  (module-browser-only-in-plt-and-module-langs
   "The module browser is only available for module-based programs.")
  (module-browser-name-length "Name length")
  (module-browser-name-short "Short")