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

...

Browse Source 
original commit: 7c5dedafb90952b9aaf6e1106343ddbf4aa4d6c9
This commit is contained in:
Robby Findler 2000-05-02 20:57:18 +00:00
parent 99a1193d0e
commit 68b8d298ab
1 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/framework/frame.ss
View File

@ -270,23 +270,26 @@
(lambda ()
(send outer-info-panel stretchable-height #f)
info-panel)))])
(public
[update-memory-text
(lambda ()
(when show-memory-text?
(send memory-text begin-edit-sequence)
(send memory-text erase)
(send memory-text insert (number->string (current-memory-use)))
(send memory-text end-edit-sequence)))])
(sequence
;; only for CVSers
(when (directory-exists? (build-path (collection-path "framework") "CVS"))
(when show-memory-text?
(let* ([panel (make-object horizontal-panel% (get-info-panel) '(border))]
[update-text
(lambda ()
(send memory-text begin-edit-sequence)
(send memory-text erase)
(send memory-text insert (number->string (current-memory-use)))
(send memory-text end-edit-sequence))]
[button (make-object button% "Collect" panel
(lambda x
(collect-garbage)
(update-text)))]
(update-memory-text)))]
[ec (make-object editor-canvas% panel memory-text '(no-hscroll no-vscroll))])
(determine-width "000000000" ec memory-text)
(update-text)
(update-memory-text)
(set! memory-cleanup
(lambda ()
(send memory-text remove-canvas ec)
@ -1355,6 +1358,7 @@
(hide-search #t))))
(define memory-text (make-object text%))
(define show-memory-text? (directory-exists? (build-path (collection-path "framework") "CVS")))
(define file<%> (interface (-editor<%>)))
(define file-mixin