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

adjust the autosave gui so that closing the window doesn't cause drracket to

Browse Source 
exit (this only happened on non-mac os x platforms)

include in 5.2
This commit is contained in:
Robby Findler 2011-10-11 10:44:00 -05:00
parent 95e29376fd
commit 4d00b13ce0
1 changed files with 37 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/framework/private/autosave.rkt
View File

@ -144,16 +144,22 @@
[filtered-table [filtered-table
(filter (λ (x) (file-exists? (cadr x))) table)]) (filter (λ (x) (file-exists? (cadr x))) table)])
(unless (null? filtered-table) (unless (null? filtered-table)
(let* ([f (new final-frame% (let* ([dlg (new dialog%
(label (string-constant recover-autosave-files-frame-title)))] (label (string-constant recover-autosave-files-frame-title)))]
[t (new text% (auto-wrap #t))] [t (new text% (auto-wrap #t))]
[ec (new editor-canvas% [ec (new editor-canvas%
(parent (send f get-area-container)) (parent dlg)
(editor t) (editor t)
(line-count 2) (line-count 2)
(stretchable-height #f)
(style '(no-hscroll)))] (style '(no-hscroll)))]
[hp (make-object horizontal-panel% (send f get-area-container))] [hp (new horizontal-panel%
[vp (make-object vertical-panel% hp)]) [parent dlg]
[stretchable-height #f])]
[vp (new vertical-panel%
[parent hp]
[stretchable-height #f])]
[details-parent (new horizontal-panel% [parent dlg])])
(send vp set-alignment 'right 'center) (send vp set-alignment 'right 'center)
(make-object grow-box-spacer-pane% hp) (make-object grow-box-spacer-pane% hp)
(send t insert (string-constant autosave-explanation)) (send t insert (string-constant autosave-explanation))
@ -161,36 +167,24 @@
(send t set-position 0 0) (send t set-position 0 0)
(send t lock #t) (send t lock #t)
(for-each (add-table-line vp f) filtered-table) (for-each (add-table-line vp dlg details-parent) filtered-table)
(make-object button% (make-object button%
(string-constant autosave-done) (string-constant autosave-done)
vp vp
(λ (x y) (λ (x y)
(when (send f can-close?) (when (send dlg can-close?)
(send f on-close) (send dlg on-close)
(send f show #f)))) (send dlg show #f))))
(send f show #t) (send dlg show #t)
(yield done-semaphore)
(void)))))) (void))))))
(define done-semaphore (make-semaphore 0)) ;; add-table-line : (is-a? area-container<%>)
;; (or/c #f (is-a?/c top-level-window<%>))
(define final-frame% ;; (is-a? area-container<%>)
(class frame:basic% ;; -> (list/c (or/c #f path?) path?)
(define/augment (can-close?) #t) ;; -> void?
(define/augment (on-close)
(inner (void) on-close)
(send (group:get-the-frame-group)
remove-frame
this)
(semaphore-post done-semaphore))
(super-new)))
;; add-table-line : (is-a? area-container<%>) (union #f (is-a?/c top-level-window<%>))
;; -> (list (union #f string[filename]) string[filename-file-exists?])
;; -> void
;; adds in a line to the overview table showing this pair of files. ;; adds in a line to the overview table showing this pair of files.
(define (add-table-line area-container parent) (define (add-table-line area-container dlg show-details-parent)
(λ (table-entry) (λ (table-entry)
(letrec ([orig-file (car table-entry)] (letrec ([orig-file (car table-entry)]
[backup-file (cadr table-entry)] [backup-file (cadr table-entry)]
@ -221,7 +215,7 @@
[details [details
(make-object button% (string-constant autosave-details) hp (make-object button% (string-constant autosave-details) hp
(λ (x y) (λ (x y)
(show-files table-entry)))] (show-files table-entry show-details-parent dlg)))]
[delete [delete
(make-object button% (make-object button%
(string-constant autosave-delete-button) (string-constant autosave-delete-button)
@ -235,7 +229,7 @@
(string-constant autosave-recover) (string-constant autosave-recover)
hp hp
(λ (recover y) (λ (recover y)
(let ([filename-result (recover-file parent table-entry)]) (let ([filename-result (recover-file dlg table-entry)])
(when filename-result (when filename-result
(disable-line) (disable-line)
(send msg2 set-label (string-constant autosave-recovered!)) (send msg2 set-label (string-constant autosave-recovered!))
@ -276,23 +270,21 @@
(delete-file autosave-file) (delete-file autosave-file)
#t)))) #t))))
;; show-files : (list (union #f string[filename]) string) -> void ;; show-files : (list (or/c #f path?) path?) (is-a?/c area-container<%>) (is-a?/c dialog%) -> void
(define (show-files table-entry) (define (show-files table-entry show-details-parent dlg)
(let ([file1 (list-ref table-entry 0)] (let ([file1 (list-ref table-entry 0)]
[file2 (list-ref table-entry 1)]) [file2 (list-ref table-entry 1)])
(define frame (make-object show-files-frame% (send dlg begin-container-sequence)
(if file1 (define had-children? #f)
(string-constant autosave-compare-files) (send show-details-parent change-children (λ (x)
(string-constant autosave-show-autosave)) (set! had-children? (not (null? x)))
#f '()))
(if file1 600 300)
600))
(define hp (new horizontal-panel%
(parent (send frame get-area-container))))
(when file1 (when file1
(add-file-viewer file1 hp (string-constant autosave-original-label))) (add-file-viewer file1 show-details-parent (string-constant autosave-original-label)))
(add-file-viewer file2 hp (string-constant autosave-autosave-label)) (add-file-viewer file2 show-details-parent (string-constant autosave-autosave-label))
(send frame show #t))) (send dlg end-container-sequence)
(unless had-children?
(send dlg center))))
;; add-file-viewer : path? -> void ;; add-file-viewer : path? -> void
(define (add-file-viewer filename parent label) (define (add-file-viewer filename parent label)
@ -305,6 +297,7 @@
#:quote-amp? #f)] #:quote-amp? #f)]
[parent vp])) [parent vp]))
(define ec (make-object editor-canvas% vp t)) (define ec (make-object editor-canvas% vp t))
(send ec min-height 400)
(send t load-file filename) (send t load-file filename)
(send t hide-caret #t) (send t hide-caret #t)
(send t lock #t)) (send t lock #t))