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

..

Browse Source 
original commit: 23d99d9a91936618278b901ea1d3cc9cf30fd977
This commit is contained in:
Robby Findler 2003-02-18 18:56:09 +00:00
parent fdeb77cc7d
commit 23e293b4c5
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/framework/private/frame.ss
View File

@ -314,7 +314,8 @@
(list (list
(make-status-line (instantiate message% () (make-status-line (instantiate message% ()
(parent status-line-container-panel) (parent status-line-container-panel)
(stretchable-width #f)) (label "")
(stretchable-width #t))
id id
1))] 1))]
[else (let ([status-line (car status-lines)]) [else (let ([status-line (car status-lines)])
@ -348,16 +349,19 @@
(cdr status-lines))] (cdr status-lines))]
[else (cons status-line (loop (cdr status-lines)))]))]))))))) [else (cons status-line (loop (cdr status-lines)))]))])))))))
(define/public (update-status-line id msg) (define/public (update-status-line id msg-txt)
(do-main-thread (do-main-thread
(lambda () (lambda ()
(let ([status-line (find-status-line id msg)]) (let* ([status-line (find-status-line id msg-txt)]
(send (status-line-message status-line) set-label msg))))) [msg (status-line-message status-line)]
[current-txt (send msg get-label)])
(unless (equal? msg-txt current-txt)
(send msg set-label msg-txt))))))
(define/private (find-status-line id msg) (define/private (find-status-line id msg-txt)
(let loop ([status-lines status-lines]) (let loop ([status-lines status-lines])
(cond (cond
[(null? status-lines) (error 'update-status-line "didn't find status line ~e, other arg ~e" id msg)] [(null? status-lines) (error 'update-status-line "didn't find status line ~e, other arg ~e" id msg-txt)]
[else [else
(let ([status-line (car status-lines)]) (let ([status-line (car status-lines)])
(if (eq? (status-line-id status-line) id) (if (eq? (status-line-id status-line) id)
@ -370,7 +374,9 @@
(if (eq? (current-thread) eventspace-main-thread) (if (eq? (current-thread) eventspace-main-thread)
(t) (t)
(parameterize ([current-eventspace (get-eventspace)]) (parameterize ([current-eventspace (get-eventspace)])
(queue-callback t)))))) (queue-callback t))))
(super-instantiate ())))
(define info<%> (interface (basic<%>) (define info<%> (interface (basic<%>)
determine-width determine-width
@ -2173,11 +2179,11 @@
(super-instantiate ()))) (super-instantiate ())))
(define basic% (basic-mixin frame%)) (define basic% (basic-mixin frame%))
(define status-line% (status-line-mixin basic%)) (define info% (info-mixin basic%))
(define info% (info-mixin status-line%))
(define text-info% (text-info-mixin info%)) (define text-info% (text-info-mixin info%))
(define pasteboard-info% (pasteboard-info-mixin text-info%)) (define pasteboard-info% (pasteboard-info-mixin text-info%))
(define standard-menus% (standard-menus-mixin pasteboard-info%)) (define status-line% (status-line-mixin text-info%))
(define standard-menus% (standard-menus-mixin status-line%))
(define editor% (editor-mixin standard-menus%)) (define editor% (editor-mixin standard-menus%))
(define open-here% (open-here-mixin editor%)) (define open-here% (open-here-mixin editor%))

4
collects/framework/private/sig.ss
View File

@ -331,6 +331,7 @@
(define-signature framework:frame-class^ (define-signature framework:frame-class^
(basic<%> (basic<%>
status-line<%>
standard-menus<%> standard-menus<%>
editor<%> editor<%>
open-here<%> open-here<%>
@ -343,7 +344,9 @@
text-info<%> text-info<%>
pasteboard-info<%> pasteboard-info<%>
file<%> file<%>
basic% basic%
status-line%
info% info%
text-info% text-info%
pasteboard-info% pasteboard-info%
@ -358,6 +361,7 @@
pasteboard-info-file% pasteboard-info-file%
basic-mixin basic-mixin
status-line-mixin
standard-menus-mixin standard-menus-mixin
editor-mixin editor-mixin
open-here-mixin open-here-mixin