suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

always show the memory use and the () status indicators in drracket's status line

Browse Source
This commit is contained in:
Robby Findler 2014-02-22 07:44:55 -06:00
parent a2b03a083a
commit 51adb339d5
2 changed files with 44 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt
View File

@ -57,14 +57,6 @@
(λ args
(apply fprintf op args))))
;; code copied from framework/private/frame.rkt
(define checkout-or-nightly?
(or (with-handlers ([exn:fail:filesystem? (λ (x) #f)])
(directory-exists? (collection-path "repo-time-stamp")))
(with-handlers ([exn:fail:filesystem? (λ (x) #f)])
(let ([fw (collection-path "framework")])
(directory-exists? (build-path fw 'up 'up ".git"))))))
;; ===================================================================================================
;; Compiled bitmaps
@ -4580,7 +4572,6 @@
(inherit get-info-panel)
(define color-status-canvas
(and checkout-or-nightly?
(let ()
(define on-string "()")
(define color-status-canvas
@ -4599,7 +4590,7 @@
(send (send color-status-canvas get-dc) get-text-extent
on-string small-control-font))
(send color-status-canvas min-width (inexact->exact (ceiling tw)))
color-status-canvas)))
color-status-canvas))
(define color-valid? #t)
(define/public (set-color-status! v?)
(when color-status-canvas

21
pkgs/gui-pkgs/gui-lib/framework/private/frame.rkt
View File

@ -870,11 +870,8 @@
(define/public (get-info-panel) info-panel)
(define/public (update-memory-text)
(when show-memory-text?
(for-each
(λ (memory-canvas)
(send memory-canvas set-str (format-number (current-memory-use))))
memory-canvases)))
(for ([memory-canvas (in-list memory-canvases)])
(send memory-canvas set-str (format-number (current-memory-use)))))
(define/private (format-number n)
(let* ([mbytes (/ n 1024 1024)]
@ -900,8 +897,7 @@
[define lock-canvas (make-object lock-canvas% (get-info-panel))]
; only for checkouts and nightly build users
(when show-memory-text?
; set up the memory use display in the status line
(let* ([panel (new horizontal-panel%
[parent (get-info-panel)]
[stretchable-width #f]
@ -923,7 +919,7 @@
(set! memory-cleanup
(λ ()
(set! memory-canvases (remq ec memory-canvases))))
(send panel stretchable-width #f)))
(send panel stretchable-width #f))
(define gc-canvas (new bday-click-canvas% [parent (get-info-panel)] [style '(border no-focus)]))
(define/private (register-gc-blit)
@ -2731,16 +2727,7 @@
(define/override (get-editor%) (text:searching-mixin (super get-editor%)))
(super-new)))
;; code copied to drracket/private/unit.rkt
(define checkout-or-nightly?
(or (with-handlers ([exn:fail:filesystem? (λ (x) #f)])
(directory-exists? (collection-path "repo-time-stamp")))
(with-handlers ([exn:fail:filesystem? (λ (x) #f)])
(let ([fw (collection-path "framework")])
(directory-exists? (build-path fw 'up 'up ".git"))))))
(define memory-canvases '())
(define show-memory-text? checkout-or-nightly?)
(define bday-click-canvas%
(class canvas%