diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss index f796160d..f1a56fac 100644 --- a/collects/framework/frame.ss +++ b/collects/framework/frame.ss @@ -802,43 +802,6 @@ update-info get-info-panel)) - (define time-edit (make-object text%)) - (define time-semaphore (make-semaphore 1)) - (define wide-time "00:00pm") - (send time-edit lock #t) - (define update-time - (lambda () - (dynamic-wind - (lambda () - (semaphore-wait time-semaphore) - (send time-edit lock #f)) - (lambda () - (send* time-edit - (erase) - (insert - (let* ([date (seconds->date - (current-seconds))] - [hours (date-hour date)] - [minutes (date-minute date)]) - (format "~a:~a~a~a" - (cond - [(= hours 0) 12] - [(<= hours 12) hours] - [else (- hours 12)]) - (quotient minutes 10) - (modulo minutes 10) - (if (< hours 12) "am" "pm")))))) - (lambda () - (send time-edit lock #t) - (semaphore-post time-semaphore))))) - (define time-thread - (thread - (rec loop - (lambda () - (update-time) - (sleep 30) - (loop))))) - (define info-mixin (mixin (-editor<%>) (info<%>) args (rename [super-make-root-area-container make-root-area-container]) @@ -898,7 +861,6 @@ [on-close (lambda () (super-on-close) - (send time-canvas set-editor #f) (unregister-collecting-blit gc-canvas) (close-panel-callback))]) @@ -951,8 +913,6 @@ b "Unlocked")) (get-info-panel))] - [time-canvas (make-object editor-canvas% (get-info-panel) #f '(no-hscroll no-vscroll))] - [_ (send time-canvas set-line-count 1)] [gc-canvas (make-object canvas% (get-info-panel) '(border))] [register-gc-blit (lambda () @@ -989,15 +949,7 @@ (set-alignment 'right 'center) (stretchable-height #f) (spacing 3) - (border 3)) - (send* time-canvas - (set-editor time-edit) - (stretchable-width #f) - (stretchable-height #f)) - (semaphore-wait time-semaphore) - (determine-width wide-time time-canvas time-edit) - (semaphore-post time-semaphore) - (update-time)))) + (border 3))))) (define text-info<%> (interface (info<%>) overwrite-status-changed diff --git a/collects/framework/group.ss b/collects/framework/group.ss index 73adb559..a385df60 100644 --- a/collects/framework/group.ss +++ b/collects/framework/group.ss @@ -201,11 +201,10 @@ (mzlib:file:normalize-path name))] [test-frame (lambda (frame) - (and (ivar-in-class? 'get-edit (object-class frame)) - (let* ([edit (send frame get-edit)] - [filename (send edit get-filename)]) - (and (send edit editing-this-file?) - (string? filename) + (and (is-a? frame frame:editor<%>) + (let* ([editor (send frame get-editor)] + [filename (send editor get-filename)]) + (and (string? filename) (string=? normalized (with-handlers ([(lambda (x) #t) (lambda (x) filename)]) diff --git a/collects/framework/panel.ss b/collects/framework/panel.ss index 35992bcd..e42f6008 100644 --- a/collects/framework/panel.ss +++ b/collects/framework/panel.ss @@ -56,8 +56,29 @@ (send current-active-child show #t))])]) (sequence (apply super-init args)))) - - (define single% (single-mixin panel%)) + + (define single-window<%> (interface (single<%>))) + (define single-window-mixin + (mixin (single<%> window<%>) (single-window<%>) args + (inherit get-client-size get-size) + (rename [super-container-size container-size]) + (override + [container-size + (lambda (l) + (let-values ([(super-width super-height) (super-container-size l)] + [(client-width client-height) (get-client-size)] + [(window-width window-height) (get-size)] + [(calc-size) + (lambda (super client window) + (+ super (max 0 (- window client))))]) + + (values + (calc-size super-width client-width window-width) + (calc-size super-height client-height window-height))))]) + (sequence + (apply super-init args)))) + + (define single% (single-window-mixin (single-mixin panel%))) (define single-pane% (single-mixin pane%)) (define -editor<%>