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

added diamond next to tab names to indicate unsaved tabs

Browse Source 
svn: r1006
This commit is contained in:
Robby Findler 2005-10-07 02:31:46 +00:00
parent 3db301fcea
commit b0520f953b
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/drscheme/private/unit.ss
View File

@ -6,10 +6,6 @@ closing:
tab panels new behavior: tab panels new behavior:
- save all tabs (pr 6689?) - save all tabs (pr 6689?)
tab panels todo:
- changing tabs needs to update all kinds of things, based on new context<%> interface setup
- need to update running when switching tabs ...
module browser threading seems wrong. module browser threading seems wrong.
|# |#
@ -1233,7 +1229,6 @@ module browser threading seems wrong.
(when execute-menu-item (when execute-menu-item
(send execute-menu-item enable #f)) (send execute-menu-item enable #f))
(send execute-button enable #f) (send execute-button enable #f)
;(send file-menu:create-new-tab-item enable #f)
(inner (void) disable-evaluation)) (inner (void) disable-evaluation))
(define/public-final (enable-evaluation-in-tab tab) (define/public-final (enable-evaluation-in-tab tab)
@ -1244,7 +1239,6 @@ module browser threading seems wrong.
(when execute-menu-item (when execute-menu-item
(send execute-menu-item enable #t)) (send execute-menu-item enable #t))
(send execute-button enable #t) (send execute-button enable #t)
;(send file-menu:create-new-tab-item enable #t)
(inner (void) enable-evaluation)) (inner (void) enable-evaluation))
(inherit set-label) (inherit set-label)
@ -1255,9 +1249,10 @@ module browser threading seems wrong.
(if save-button (if save-button
(unless (eq? mod? (send save-button is-shown?)) (unless (eq? mod? (send save-button is-shown?))
(send save-button show mod?)) (send save-button show mod?))
(set! save-init-shown? mod?)))) (set! save-init-shown? mod?))
(update-tab-label current-tab)))
;; update-save-message : (union #f string) -> void ;; update-save-message : -> void
;; sets the save message. If input is #f, uses the frame's ;; sets the save message. If input is #f, uses the frame's
;; title. ;; title.
(define/public (update-save-message) (define/public (update-save-message)
@ -1269,12 +1264,7 @@ module browser threading seems wrong.
(update-tabs-labels)) (update-tabs-labels))
(define/private (update-tabs-labels) (define/private (update-tabs-labels)
(for-each (for-each (λ (tab) (update-tab-label tab)) tabs)
(λ (tab)
(let* ([label (get-defs-tab-label (send tab get-defs) tab)])
(unless (equal? label (send tabs-panel get-item-label (send tab get-i)))
(send tabs-panel set-item-label (send tab get-i) label))))
tabs)
(send tabs-panel set-selection (send current-tab get-i)) (send tabs-panel set-selection (send current-tab get-i))
(send (send tabs-panel get-parent) (send (send tabs-panel get-parent)
change-children change-children
@ -1287,11 +1277,18 @@ module browser threading seems wrong.
l l
(cons tabs-panel l))])))) (cons tabs-panel l))]))))
(define/private (update-tab-label tab)
(let ([label (get-defs-tab-label (send tab get-defs) tab)])
(unless (equal? label (send tabs-panel get-item-label (send tab get-i)))
(send tabs-panel set-item-label (send tab get-i) label))))
(define/private (get-defs-tab-label defs tab) (define/private (get-defs-tab-label defs tab)
(let ([fn (send defs get-filename)]) (let ([fn (send defs get-filename)])
(add-modified-flag
defs
(if fn (if fn
(get-tab-label-from-filename fn tab) (get-tab-label-from-filename fn tab)
(send defs get-filename/untitled-name)))) (send defs get-filename/untitled-name)))))
(define/private (get-tab-label-from-filename fn tab) (define/private (get-tab-label-from-filename fn tab)
(let* ([take-n (let* ([take-n
@ -1333,6 +1330,11 @@ module browser threading seems wrong.
(max new-size size)))]))]) (max new-size size)))]))])
(path->string (apply build-path (reverse (take-n size exp)))))) (path->string (apply build-path (reverse (take-n size exp))))))
(define/private (add-modified-flag text string)
(if (send text is-modified?)
(string-append "◆ " string)
string))
[define/override get-canvas% (λ () (drscheme:get/extend:get-definitions-canvas))] [define/override get-canvas% (λ () (drscheme:get/extend:get-definitions-canvas))]
(define/public (update-running running?) (define/public (update-running running?)