added log-viewing support to DrScheme

svn: r13291

collects/drscheme/private/drsig.ss

@@ -94,6 +94,7 @@
      primitive-eval
      primitive-load
      error-display-handler-message-box-title
+     system-logger
      system-custodian
      system-eventspace
      system-namespace

collects/drscheme/private/init.ss

@@ -14,6 +14,8 @@
   (define primitive-eval (current-eval))
   (define primitive-load (current-load))
   
+  (define system-logger (current-logger))
+  
   (define system-custodian (current-custodian))
   (define system-eventspace (current-eventspace))
   (define system-thread (current-thread))

collects/drscheme/private/main.ss

@@ -132,7 +132,11 @@
                            number-between-zero-and-one?)
   (preferences:set-default 'drscheme:module-browser-size-percentage
                            1/5
+                           number-between-zero-and-one?)
+  (preferences:set-default 'drscheme:logging-size-percentage
+                           3/4
                            number-between-zero-and-one?))
+
 (preferences:set-default 'drscheme:module-browser:name-length 1 
                          (λ (x) (memq x '(0 1 2))))
 

collects/drscheme/private/rep.ss

@@ -479,6 +479,9 @@ TODO
                   deltas)
         (values before after))))
   
+  (define log-max-size 1000)
+  (define log-entry-max-size 1000)
+  
   (define text-mixin
     (mixin ((class->interface text%)
             text:ports<%>
@@ -796,12 +799,11 @@ TODO
       
       (define/override (after-io-insertion)
         (super after-io-insertion)
-        (let ([canvas (get-active-canvas)])
+        (let ([frame (get-frame)])
-          (when canvas
+          (when frame
-            (let ([frame (send canvas get-top-level-window)])
+            (let ([tab (send definitions-text get-tab)])
-              (let ([tab (send definitions-text get-tab)])
+              (when (eq? (send frame get-current-tab) tab)
-                (when (eq? (send frame get-current-tab) tab)
+                (send context ensure-rep-shown this))))))
-                  (send context ensure-rep-shown this)))))))
       
       (define/augment (after-insert start len)
         (inner (void) after-insert start len)
@@ -872,11 +874,12 @@ TODO
              (user-namespace-box (make-weak-box #f))
              (user-eventspace-main-thread #f)
              (user-break-parameterization #f)
+             (user-logger (make-logger))
              
              ;; user-exit-code (union #f (integer-in 0 255))
              ;; #f indicates that exit wasn't called. Integer indicates exit code
              (user-exit-code #f))
-      
+            
       (define/public (get-user-language-settings) user-language-settings)
       (define/public (get-user-custodian) user-custodian)
       (define/public (get-user-eventspace) (weak-box-value user-eventspace-box))
@@ -915,9 +918,7 @@ TODO
           (lock #t)
           (when (and show-no-user-evaluation-message? (not shutting-down?))
             (no-user-evaluation-message
-             (let ([canvas (get-active-canvas)])
+             (get-frame)
-               (and canvas
-                    (send canvas get-top-level-window)))
              user-exit-code
              (not (thread-running? memory-killed-thread))))
           (set! show-no-user-evaluation-message? #t)))
@@ -1227,6 +1228,8 @@ TODO
           (set! eval-thread-queue-sema (make-semaphore 0))
           (set! user-exit-code #f)
           
+          (reset-logger-messages)
+          
           (let* ([init-thread-complete (make-semaphore 0)]
                  [goahead (make-semaphore)])
             
@@ -1241,6 +1244,32 @@ TODO
                  (break-enabled #f)
                  (set! user-eventspace-main-thread (current-thread))
                  
+                 (current-logger user-logger)
+                 
+                 (thread
+                  (λ ()
+                    ;; forward system events the the user's logger,
+                    ;; and record any events that happen on the user's logger to show in the GUI
+                    (let ([sys-evt (make-log-receiver drscheme:init:system-logger 'debug)]
+                          [user-evt (make-log-receiver user-logger 'debug)])
+                      (let loop ()
+                        (sync
+                         (handle-evt
+                          sys-evt
+                          (λ (logged)
+                            (log-message user-logger 
+                                         (vector-ref logged 0)
+                                         (vector-ref logged 1)
+                                         (vector-ref logged 2))
+                            (loop)))
+                         (handle-evt
+                          user-evt
+                          (λ (vec)
+                            (parameterize ([current-eventspace drscheme:init:system-eventspace])
+                              (queue-callback (λ () (new-log-message vec))))
+                            (loop))))))))
+                 
+                 
                  (let ([drscheme-exit-handler
                         (λ (x)
                           (parameterize-break
@@ -1391,6 +1420,39 @@ TODO
            (λ ()
              (send context update-running bool)))))
       
+      (define logger-editor #f)
+      (define logger-messages '())
+      (define/public (get-logger-messages) logger-messages)
+      (define/private (new-log-message vec)
+        (let ([level (vector-ref vec 0)]
+              [str (cond
+                     [(<= (string-length (vector-ref vec 1)) log-entry-max-size)
+                      (vector-ref vec 1)]
+                     [else
+                      (substring (vector-ref vec 1) 0 log-entry-max-size)])])
+          (cond
+            [(< (length logger-messages) log-max-size)
+             (set! logger-messages (cons (vector level str) logger-messages))]
+            [else
+             (set! logger-messages
+                   (cons
+                    (vector level str)
+                    (let loop ([msgs logger-messages])
+                      (cond
+                        [(null? (cdr msgs)) null]
+                        [else (cons (car msgs) (loop (cdr msgs)))]))))])
+          (update-logger-gui)))
+      
+      (define/private (reset-logger-messages) 
+        (set! logger-messages '())
+        (update-logger-gui))
+
+      (define/private (update-logger-gui)
+        (let ([frame (get-frame)])
+          (when frame
+            (send frame update-logger-window))))
+      
+      
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;;                                          ;;;
       ;;;                Execution                 ;;;
@@ -1420,7 +1482,7 @@ TODO
         (current-error-port (get-err-port))
         (current-value-port (get-value-port))
         (current-input-port (get-in-box-port))
-        
+
         (current-print (lambda (v) (display-results (list v)))))
       
       (define/private (initialize-dispatch-handler) ;;; =User=
@@ -1680,6 +1742,22 @@ TODO
                                        (floor (/ width char-width)))])
                 (send dc set-font old-font)
                 (pretty-print-columns new-columns))))))
+
+      
+      ;; get-frame : -> (or/c #f (is-a?/c frame))
+      (define/private (get-frame)
+        (let ([c (get-any-canvas)])
+          (and c (send c get-top-level-window))))
+      
+
+      ;; returns the most recently active canvas or, if no canvas
+      ;; has ever been active, it returns just any canvas
+      (define/private (get-any-canvas)
+        (or (get-active-canvas)
+            (let ([canvases (get-canvases)])
+              (and (not (null? canvases))
+                   (car canvases)))))
+
       (super-new)
       (auto-wrap #t)
       (set-styles-sticky #f)

collects/drscheme/private/unit.ss

@@ -1,6 +1,11 @@
 #lang scheme/base
 #|
 
+logger: multiple tabs need to save logger visibilty state
+
+logger: thread for collecting user messages should be created under user auspicies.
+logger: what about thread for forwarding log messages?
+
 closing:
   warning messages don't have frame as parent.....
 
@@ -89,7 +94,8 @@ module browser threading seems wrong.
         is-current-tab?
         get-enabled
         on-close
-        can-close?))
+        can-close?
+        toggle-log))
     
     (define definitions-text<%> 
       (interface ()
@@ -1314,13 +1320,21 @@ module browser threading seems wrong.
         
         (define/public-final (is-current-tab?) (eq? this (send frame get-current-tab)))
         
+        (define log-visible? #f)
+        (define/public-final (toggle-log)
+          (set! log-visible? (not log-visible?))
+          (send frame show/hide-log log-visible?))
+        (define/public-final (update-log)
+          (send frame show/hide-log log-visible?))
+        
         (super-new)))
     
-    ;; should only be called by the tab% object
+    ;; should only be called by the tab% object (and the class itself)
     (define-local-member-name 
       disable-evaluation-in-tab
       enable-evaluation-in-tab
-      update-toolbar-visibility)
+      update-toolbar-visibility
+      show/hide-log)
     
     (define -frame<%>
       (interface (drscheme:frame:<%> frame:searchable-text<%> frame:delegate<%> frame:open-here<%>)
@@ -1370,27 +1384,117 @@ module browser threading seems wrong.
                  file-menu:get-revert-item
                  file-menu:get-print-item)
         
-        ;; logging : (union #f string[directory-name])
+        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-        (field [logging #f]
+        ;;
-               [definitions-log-counter 0]  ;; number
+        ;; logging 
-               [interactions-log-counter 0] ;; number
+        ;;
-               [logging-parent-panel #f]    ;; panel (unitialized short time only)
+        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-               [logging-panel #f]           ;; panel (unitialized short time only)
+        
-               [logging-menu-item #f])      ;; menu-item (unitialized short time only)
+        (define logger-panel #f)
-        ;; log-definitions : -> void
+        (define logger-parent-panel #f)
-        (define/private (log-definitions)
+        
-          (when logging
+        ;; logger-gui-tab-panel: (or/c #f (is-a?/c tab-panel%))
-            (set! definitions-log-counter (+ definitions-log-counter 1))
+        ;; this is #f when the GUI has not been built yet. After
+        ;; it becomes a tab-panel, it is always a tab-panel (altho the tab panel might not always be shown)
+        (define logger-gui-tab-panel #f)
+        
+        ;; logger-gui-text: (or/c #f (is-a?/c tab-panel%))
+        ;; this is #f when the GUI has not been built or when the logging panel is hidden
+        ;; in that case, the logging messages aren't begin saved in an editor anywhere
+        (define logger-gui-text #f)
+        
+        (define logger-menu-item #f)
+
+        (define/public-final (show/hide-log show?)
+          (let ([p (preferences:get 'drscheme:logging-size-percentage)])
+            (begin-container-sequence)
+            (cond
+              [logger-gui-tab-panel
+               (send logger-parent-panel change-children
+                     (λ (l)
+                       (cond
+                         [(or (and show? (member logger-panel l))
+                              (and (not show?)
+                                   (not (member logger-panel l))))
+                          ;; if things are already up to date, only update the logger text
+                          (when show?
+                            (update-logger-window))
+                          l]
+                         [show? 
+                          (new-logger-text)
+                          (update-logger-window)
+                          (send logger-menu-item set-label (string-constant hide-log))
+                          (append (remq logger-panel l) (list logger-panel))]
+                         [else
+                          (send logger-menu-item set-label (string-constant show-log))
+                          (set! logger-gui-text #f)
+                          (remq logger-panel l)])))]
+              [else
+               (when show? ;; if we want to hide and it isn't built yet, do nothing
+                 (set! logger-gui-tab-panel
+                       (new tab-panel% 
+                            [choices (list (string-constant logging-all)
+                                           "fatal" "error" "warning" "info" "debug")]
+                            [parent logger-panel]
+                            [callback
+                             (λ (tp evt)
+                               (update-logger-window))]))
+                 (new-logger-text)
+                 (new editor-canvas% [parent logger-gui-tab-panel] [editor logger-gui-text])
+                 (send logger-menu-item set-label (string-constant hide-log))
+                 (update-logger-window)
+                 (send logger-parent-panel change-children (lambda (l) (append l (list logger-panel)))))])
+            (with-handlers ([exn:fail? void])
+              (send logger-parent-panel set-percentages (list p (- 1 p))))
+            (end-container-sequence)))
+        
+        (define/private (new-logger-text)
+          (set! logger-gui-text (new (text:hide-caret/selection-mixin text:basic%)))
+          (send logger-gui-text lock #t))
+        
+        (define/public (update-logger-window)
+          (when logger-gui-text 
+            (send logger-gui-text begin-edit-sequence)
+            (send logger-gui-text lock #f)
+            (send logger-gui-text erase)
+            (let ([level (case (send logger-gui-tab-panel get-selection)
+                           [(0) #f]
+                           [(1) 'fatal]
+                           [(2) 'error]
+                           [(3) 'warning]
+                           [(4) 'info]
+                           [(5) 'debug])])
+              (for-each
+               (λ (x)
+                 (when (or (not level)
+                           (eq? level (vector-ref x 0)))
+                   (send logger-gui-text insert "\n" 0 0)
+                   (send logger-gui-text insert (vector-ref x 1) 0 0)))
+               (send interactions-text get-logger-messages)))
+            (send logger-gui-text lock #t)
+            (send logger-gui-text end-edit-sequence)))
+        
+        ;; transcript : (union #f string[directory-name])
+        (field [transcript #f]
+               [definitions-transcript-counter 0]  ;; number
+               [interactions-transcript-counter 0] ;; number
+               [transcript-parent-panel #f]    ;; panel (unitialized short time only)
+               [transcript-panel #f]           ;; panel (unitialized short time only)
+               [transcript-menu-item #f])      ;; menu-item (unitialized short time only)
+        ;; record-definitions : -> void
+        (define/private (record-definitions)
+          (when transcript
+            (set! definitions-transcript-counter (+ definitions-transcript-counter 1))
             (send definitions-text save-file 
-                  (build-path logging (format "~a-definitions" (pad-two definitions-log-counter)))
+                  (build-path transcript (format "~a-definitions" (pad-two definitions-transcript-counter)))
                   'copy)))
         
-        ;; log-ineractions : -> void
+        ;; record-ineractions : -> void
-        (define/private (log-interactions)
+        (define/private (record-interactions)
-          (when logging
+          (when transcript
-            (set! interactions-log-counter (+ interactions-log-counter 1))
+            (set! interactions-transcript-counter (+ interactions-transcript-counter 1))
             (send interactions-text save-file 
-                  (build-path logging (format "~a-interactions" (pad-two interactions-log-counter)))
+                  (build-path transcript (format "~a-interactions" (pad-two interactions-transcript-counter)))
                   'copy)))
         
         ;; pad-two : number -> string
@@ -1400,50 +1504,51 @@ module browser threading seems wrong.
             [(<= 0 n 9) (format "0~a" n)]
             [else (format "~a" n)]))
         
-        ;; start-logging : -> void
+        ;; start-transcript : -> void
-        ;; turns on the logging and shows the logging gui
+        ;; turns on the transcript and shows the transcript gui
-        (define/private (start-logging)
+        (define/private (start-transcript)
-          (let ([log-directory (mred:get-directory
+          (let ([transcript-directory (mred:get-directory
-                                (string-constant please-choose-a-log-directory)
+                                       (string-constant please-choose-a-log-directory)
-                                this)])
+                                       this)])
-            (when (and log-directory
+            (when (and transcript-directory
-                       (ensure-empty log-directory))
+                       (ensure-empty transcript-directory))
-              (send logging-menu-item set-label (string-constant stop-logging))
+              (send transcript-menu-item set-label (string-constant stop-logging))
-              (set! logging log-directory)
+              (set! transcript transcript-directory)
-              (set! definitions-log-counter 0)
+              (set! definitions-transcript-counter 0)
-              (set! interactions-log-counter 0)
+              (set! interactions-transcript-counter 0)
-              (build-logging-panel)
+              (build-transcript-panel)
-              (log-definitions))))
+              (record-definitions))))
         
-        ;; stop-logging : -> void
+        ;; stop-transcript : -> void
-        ;; turns off the logging procedure
+        ;; turns off the transcript procedure
-        (define/private (stop-logging)
+        (define/private (stop-transcript)
-          (log-interactions)
+          (record-interactions)
-          (send logging-menu-item set-label (string-constant log-definitions-and-interactions))
+          (send transcript-menu-item set-label (string-constant log-definitions-and-interactions))
-          (set! logging #f)
+          (set! transcript #f)
-          (send logging-panel change-children (λ (l) null)))
+          (send transcript-panel change-children (λ (l) null)))
         
-        ;; build-logging-panel : -> void
+        ;; build-transcript-panel : -> void
-        ;; builds the contents of the logging panel
+        ;; builds the contents of the transcript panel
-        (define/private (build-logging-panel)
+        (define/private (build-transcript-panel)
-          (define hp (make-object horizontal-panel% logging-panel '(border)))
+          (define hp (make-object horizontal-panel% transcript-panel '(border)))
           (make-object message% (string-constant logging-to) hp)
-          (send (make-object message% (path->string logging) hp) stretchable-width #t)
+          (send (make-object message% (path->string transcript) hp) stretchable-width #t)
-          (make-object button% (string-constant stop-logging) hp (λ (x y) (stop-logging))))
+          (make-object button% (string-constant stop-logging) hp (λ (x y) (stop-transcript))))
         
         ;; ensure-empty : string[directory] -> boolean
-        ;; if the log-directory is empty, just return #t
+        ;; if the transcript-directory is empty, just return #t
         ;; if not, ask the user about emptying it. 
         ;;   if they say yes, try to empty it.
         ;;     if that fails, report the error and return #f.
         ;;     if it succeeds, return #t.
         ;;   if they say no, return #f.
-        (define/private (ensure-empty log-directory)
+        (define/private (ensure-empty transcript-directory)
-          (let ([dir-list (directory-list log-directory)])
+          (let ([dir-list (directory-list transcript-directory)])
             (or (null? dir-list)
                 (let ([query (message-box 
                               (string-constant drscheme)
-                              (gui-utils:format-literal-label (string-constant erase-log-directory-contents) log-directory)
+                              (gui-utils:format-literal-label (string-constant erase-log-directory-contents)
+                                                              transcript-directory)
                               this
                               '(yes-no))])
                   (cond
@@ -1460,29 +1565,42 @@ module browser threading seems wrong.
                                                      (format "~s" exn)))
                                          this)
                                         #f)])
-                       (for-each (λ (file) (delete-file (build-path log-directory file)))
+                       (for-each (λ (file) (delete-file (build-path transcript-directory file)))
                                  dir-list)
                        #t)])))))
         
         (define/override (make-root-area-container cls parent)
-          (let* ([outer-panel (super make-root-area-container module-browser-dragable-panel% parent)]
+          (let* ([saved-p (preferences:get 'drscheme:module-browser-size-percentage)]
-                 [saved-p (preferences:get 'drscheme:module-browser-size-percentage)]
+                 [saved-p2 (preferences:get 'drscheme:logging-size-percentage)]
+                 [outer-panel (super make-root-area-container 
+                                     (make-two-way-prefs-dragable-panel% panel:horizontal-dragable%
+                                                                         'drscheme:module-browser-size-percentage)
+                                     parent)]
                  [_module-browser-panel (new vertical-panel%
                                              (parent outer-panel)
                                              (alignment '(left center))
                                              (stretchable-width #f))]
-                 [louter-panel (make-object vertical-panel% outer-panel)]
+                 [logger-outer-panel (new (make-two-way-prefs-dragable-panel% panel:vertical-dragable%
-                 [root (make-object cls louter-panel)])
+                                                                              'drscheme:logging-size-percentage)
+                                          [parent outer-panel]
+                                          [stretchable-height #f])]
+                 [trans-outer-panel (new vertical-panel% [parent logger-outer-panel] [stretchable-height #f])]
+                 [root (make-object cls trans-outer-panel)])
             (set! module-browser-panel _module-browser-panel)
             (set! module-browser-parent-panel outer-panel)
             (send outer-panel change-children (λ (l) (remq module-browser-panel l)))
-            (preferences:set 'drscheme:module-browser-size-percentage saved-p)
+            (set! logger-parent-panel logger-outer-panel)
-            (set! logging-parent-panel (new horizontal-panel%
+            (set! logger-panel (new vertical-panel% [parent logger-parent-panel]))
-                                            (parent louter-panel)
+            (send logger-parent-panel change-children (lambda (x) (remq logger-panel x)))
+            (set! transcript-parent-panel (new horizontal-panel%
+                                            (parent trans-outer-panel)
                                             (stretchable-height #f)))
-            (set! logging-panel (make-object horizontal-panel% logging-parent-panel))
+            (set! transcript-panel (make-object horizontal-panel% transcript-parent-panel))
             (unless (toolbar-shown?)
-              (send logging-parent-panel change-children (λ (l) '())))
+              (send transcript-parent-panel change-children (λ (l) '())))
+            (preferences:set 'drscheme:module-browser-size-percentage saved-p)
+            (preferences:set 'drscheme:logging-size-percentage saved-p2)
+            
             root))
         
         (inherit show-info hide-info is-info-hidden?)
@@ -1522,7 +1640,7 @@ module browser threading seems wrong.
               [hidden?
                (hide-info)
                (send top-outer-panel change-children (λ (l) '()))
-               (send logging-parent-panel change-children (λ (l) '()))]
+               (send transcript-parent-panel change-children (λ (l) '()))]
               [top? (orient/show #t)]
               [left? (orient/show #t)]
               [right? (orient/show #f)]))
@@ -1567,7 +1685,7 @@ module browser threading seems wrong.
                         (cons top-outer-panel (remq top-outer-panel l))
                         (append (remq top-outer-panel l) (list top-outer-panel)))))
             (send top-outer-panel change-children (λ (l) (list top-panel)))
-            (send logging-parent-panel change-children (λ (l) (list logging-panel)))
+            (send transcript-parent-panel change-children (λ (l) (list transcript-panel)))
             (if vertical? 
                 (send top-panel change-children (λ (x) (remq name-panel x)))
                 (send top-panel change-children (λ (x) (cons name-panel (remq name-panel x)))))
@@ -2261,7 +2379,7 @@ module browser threading seems wrong.
                  (λ () (file-menu:get-save-as-item))
                  ;(λ () (file-menu:save-as-text-item)) ; Save As Text...
                  (λ () (file-menu:get-print-item))))
-          (send file-menu:print-transcript-item enable interactions-shown?))
+          (send file-menu:print-interactions-item enable interactions-shown?))
         
         (define/augment (can-close?)
           (and (andmap (lambda (tab)
@@ -2280,8 +2398,8 @@ module browser threading seems wrong.
                     tabs)
           (when (eq? this newest-frame)
             (set! newest-frame #f))
-          (when logging
+          (when transcript
-            (stop-logging))
+            (stop-transcript))
           (remove-show-status-line-callback)
           (remove-bug-icon-callback)
           (send interactions-text on-close))
@@ -2309,9 +2427,9 @@ module browser threading seems wrong.
             (check-if-save-file-up-to-date)
             (when (preferences:get 'drscheme:show-interactions-on-execute)
               (ensure-rep-shown interactions-text))
-            (when logging
+            (when transcript
-              (log-definitions)
+              (record-definitions)
-              (log-interactions))
+              (record-interactions))
             (send definitions-text just-executed)
             (send language-message set-yellow #f)
             (send interactions-canvas focus)
@@ -2477,6 +2595,7 @@ module browser threading seems wrong.
             (send definitions-text set-delegate old-delegate)
             (update-running (send current-tab is-running?))
             (on-tab-change old-tab current-tab)
+            (send tab update-log)
             
             (restore-visible-tab-regions)
             (for-each (λ (defs-canvas) (send defs-canvas refresh))
@@ -2498,7 +2617,7 @@ module browser threading seems wrong.
             (let ([delegate (send from-defs get-delegate)])
               (send from-defs set-delegate #f)
               (send to-defs set-delegate delegate)))
-          
+                    
           (inner (void) on-tab-change from-tab to-tab))
         
         (define/public (next-tab) (change-to-delta-tab +1))
@@ -2790,7 +2909,15 @@ module browser threading seems wrong.
                      [label (string-constant toolbar-hidden)]
                      [parent toolbar-menu]
                      [callback (λ (x y) (set-toolbar-hidden))]
-                     [checked #f])))
+                     [checked #f]))
+          
+          (set! logger-menu-item
+                (new menu-item%
+                     [label (string-constant show-log)]
+                     [parent show-menu]
+                     [callback
+                      (λ (x y) (send current-tab toggle-log))]))
+          )
         
         
         ;                                                                                                       
@@ -2995,7 +3122,7 @@ module browser threading seems wrong.
         ;                                            
         
         (define execute-menu-item #f)
-        (define file-menu:print-transcript-item #f)
+        (define file-menu:print-interactions-item #f)
         (define file-menu:create-new-tab-item #f)
         
         (define/override (file-menu:between-new-and-open file-menu)
@@ -3056,20 +3183,20 @@ module browser threading seems wrong.
                   (when filename
                     (send interactions-text save-file/gui-error filename 'text)))))
             (make-object separator-menu-item% file-menu)
-            (set! logging-menu-item
+            (set! transcript-menu-item
                   (make-object menu:can-restore-menu-item%
                     (string-constant log-definitions-and-interactions)
                     file-menu
                     (λ (x y)
-                      (if logging
+                      (if transcript
-                          (stop-logging)
+                          (stop-transcript)
-                          (start-logging)))))
+                          (start-transcript)))))
             (make-object separator-menu-item% file-menu)
             (super file-menu:between-save-as-and-print file-menu)))
         
         [define/override file-menu:print-string (λ () (string-constant print-definitions))]
         (define/override (file-menu:between-print-and-close file-menu)
-          (set! file-menu:print-transcript-item
+          (set! file-menu:print-interactions-item
                 (make-object menu:can-restore-menu-item%
                   (string-constant print-interactions)
                   file-menu
@@ -4177,16 +4304,15 @@ module browser threading seems wrong.
     
     (define -frame% (frame-mixin super-frame%))
     
-    (define module-browser-dragable-panel%
+    (define (make-two-way-prefs-dragable-panel% % pref-key)
-      (class panel:horizontal-dragable%
+      (class %
         (inherit get-percentages)
         (define/augment (after-percentage-change)
           (let ([percentages (get-percentages)])
             (when (and (pair? percentages)
                        (pair? (cdr percentages))
                        (null? (cddr percentages)))
-              (preferences:set 'drscheme:module-browser-size-percentage
+              (preferences:set pref-key (car percentages))))
-                               (car percentages))))
           (inner (void) after-percentage-change))
         (super-new)))
     

collects/framework/private/panel.ss

@@ -238,8 +238,12 @@
       (define/private (update-percentages)
         (let ([len-children (length (get-children))])
           (unless (= len-children (length percentages))
-            (let ([rat (/ 1 len-children)])
+            (cond
-              (set! percentages (build-list len-children (λ (i) (make-percentage rat)))))
+              [(zero? len-children)
+               '()]
+              [else
+               (let ([rat (/ 1 len-children)])
+                 (set! percentages (build-list len-children (λ (i) (make-percentage rat)))))])
             (after-percentage-change))))
       
       (define/override (after-new-child child)
@@ -373,7 +377,10 @@
                                          (list-ref child-info 3)))])
                  (loop (cdr percentages)
                        (cdr children-info)
-                       (max (/ child-major (percentage-% percentage)) major-size)
+                       (max (if (zero? (percentage-% percentage))
+                                0
+                                (/ child-major (percentage-% percentage)))
+                            major-size)
                        (max child-minor minor-size))))])))
       
       (super-instantiate (parent))))

collects/planet/planet.scrbl

@@ -189,6 +189,16 @@ match only the exact package version 2.1 of the @filepath{zip.plt} package.
 
 @;@subsection{The Diamond Property}
 
+@subsection{Monitoring PLaneT's progress}
+
+PLaneT logs information about what it is doing to the @tt{info}
+log (via @scheme[log-info]). 
+In DrScheme, you can view the logs from the @onscreen{Show Log}
+menu item in the @onscreen{View} menu, and MzScheme's logging output
+can be controlled via command-line options and via environment
+variables. See 
+@secref["logging" #:doc '(lib "scribblings/reference/reference.scrbl")] 
+for more details.
 
 @section[#:tag "search-order"]{The PLaneT Search Order}
 

collects/scribblings/drscheme/menus.scrbl

@@ -201,11 +201,15 @@ appears at any time.
 
  @item{@defmenuitem{Hide Module Browser} Hides the module browser.}
 
- @item{@defmenuitem{Show Toolbar} Makes the toolbar (along the top of
+ @item{@defmenuitem{Toolbar} 
-   DrScheme's window) and the status line (along the bottom) visible.}
+@itemize{
+@item{@defmenuitem{Toolbar on Left} Moves the tool bar (defaultly on the top of DrScheme's window) to the left-hand side, organized vertically.}
+@item{@defmenuitem{Toolbar on Top} Moves the toolbar to the top of the DrScheme window.}
+@item{@defmenuitem{Toolbar on Right} Moves the tool bar to the right-hand side, organized vertically.}
+@item{@defmenuitem{Toolbar Hidden} Hides the toolbar entirely.}}}
 
- @item{@defmenuitem{Hide Toolbar} Hides the toolbar (along the top of
+ @item{@defmenuitem{Show Log} Shows the current log messages.}
-   DrScheme's window) and the status line (along the bottom).}
+ @item{@defmenuitem{Hide Log} Hides the current log messages.}
 
  @item{@defmenuitem{Show Profile} Shows the current profiling
    report. This menu is useful only if you have enabled profiling in

collects/string-constants/english-string-constants.ss

@@ -243,8 +243,9 @@ please adhere to these guidelines:
  (error-erasing-log-directory "Error erasing log directory contents.\n\n~a\n")
 
   ;; menu items connected to the logger
-  (show-log "Show Log")
+  (show-log "Show &Log")
-  (hide-log "Hide Log")
+  (hide-log "Hide &Log")
+  (logging-all "All") ;; in the logging window in drscheme, shows all logs simultaneously
   
  ;; modes
  (mode-submenu-label "Modes")
@@ -725,10 +726,10 @@ please adhere to these guidelines:
   (prev-tab "Previous Tab")
 
  (view-menu-label "&View")
- (show-overview "Show Program Contour") 
+ (show-overview "Show &Program Contour") 
- (hide-overview "Hide Program Contour")
+ (hide-overview "Hide &Program Contour")
- (show-module-browser "Show Module Browser")
+ (show-module-browser "Show &Module Browser")
- (hide-module-browser "Hide Module Browser")
+ (hide-module-browser "Hide &Module Browser")
 
   (help-menu-label "&Help")
  (about-info "Credits and details for this application")

doc/release-notes/drscheme/HISTORY.txt

@@ -1,3 +1,12 @@
+------------------------------
+        Version 4.1.5
+------------------------------
+
+  . Added logging support to DrScheme; it now monitors the logs via
+    the "View | Show Log" menu item.
+
+  . PLaneT now logs what it is doing at the 'info' level.
+
 ------------------------------
         Version 4.1.4
 ------------------------------