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

..

Browse Source 
original commit: 7b30c4a72a9522fa515bff630214f4bab2a2c41d
This commit is contained in:
Robby Findler 2002-09-03 13:14:21 +00:00
parent 332d616512
commit 992cf386f1
2 changed files with 37 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/framework/framework.ss
View File

@ -266,7 +266,7 @@
"garbage collection.") "garbage collection.")
(autosave:restore-autosave-files/gui (autosave:restore-autosave-files/gui
(-> void?) (-> (union false? (is-a?/c top-level-window<%>)))
() ()
"Opens a GUI to ask the user about recovering any autosave files" "Opens a GUI to ask the user about recovering any autosave files"
"left around from crashes and things.") "left around from crashes and things.")

66
collects/framework/private/autosave.ss
View File

@ -5,9 +5,7 @@
"sig.ss" "sig.ss"
(lib "mred-sig.ss" "mred") (lib "mred-sig.ss" "mred")
(lib "list.ss") (lib "list.ss")
(lib "string-constant.ss" "string-constants") (lib "string-constant.ss" "string-constants"))
;(file "/home/robby/cvs/plt/collects/string-constants/string-constant.ss")
)
(provide autosave@) (provide autosave@)
@ -71,7 +69,7 @@
(let* ([new-filename (send object do-autosave)] (let* ([new-filename (send object do-autosave)]
[tmp-box (box #f)] [tmp-box (box #f)]
[filename (send object get-filename tmp-box)]) [filename (send object get-filename tmp-box)])
(printf "autosave ~s to ~s\n" filename new-filename) (printf "autosave ~s ~s to ~s\n" object filename new-filename)
(loop (cdr orig-objects) (loop (cdr orig-objects)
(if new-filename (if new-filename
(cons (list (and (not (unbox tmp-box)) filename) (cons (list (and (not (unbox tmp-box)) filename)
@ -83,26 +81,6 @@
name-mapping name-mapping
new-objects)))))) new-objects))))))
;; removed-autosave : string[filename] -> void
;; cal to indicate to that autosave filename returned from `do-autosave'
;; has been deleted (eg, the file was saved, or the user closed the window, etc)
(define (removed-autosave filename)
(when (file-exists? autosave-toc-filename)
(let* ([old-contents (call-with-input-file autosave-toc-filename read)]
[new-contents
(remove filename
old-contents
(lambda (filename table-entry)
(equal? (cadr table-entry) filename)))])
(when (file-exists? autosave-toc-save-filename)
(delete-file autosave-toc-save-filename))
(copy-file autosave-toc-filename autosave-toc-save-filename)
(call-with-output-file autosave-toc-filename
(lambda (port)
(write new-contents port))
'truncate
'text))))
(define timer #f) (define timer #f)
(define (register b) (define (register b)
@ -117,18 +95,18 @@
(cons weak-box (loop (cdr objects))) (cons weak-box (loop (cdr objects)))
(loop (cdr objects))))])))) (loop (cdr objects))))]))))
;; restore-autosave-files/gui : -> void ;; restore-autosave-files/gui : -> (union #f (is-a?/c top-level-window<%>))
;; opens a frame that lists the autosave files that have changed. ;; opens a frame that lists the autosave files that have changed.
(define (restore-autosave-files/gui) (define (restore-autosave-files/gui)
(when (file-exists? autosave-toc-filename) (and (file-exists? autosave-toc-filename)
(let* ([table (call-with-input-file autosave-toc-filename read)] (let* ([table (call-with-input-file autosave-toc-filename read)]
;; assume that the autosave file was deleted due to the file being saved ;; assume that the autosave file was deleted due to the file being saved
[filtered-table [filtered-table
(filter (lambda (x) (file-exists? (cadr x))) table)]) (filter (lambda (x) (file-exists? (cadr x))) table)])
(unless (null? filtered-table) (and (not (null? filtered-table))
(let ([f (make-object frame:basic% (string-constant recover-autosave-files-frame-title) #f 400 400)]) (let ([f (make-object frame:basic% (string-constant recover-autosave-files-frame-title))])
(for-each (add-table-line f) filtered-table) (for-each (add-table-line (send f get-area-container)) filtered-table)
(send f show #t)))))) f)))))
;; add-table-line : (is-a? area-container<%>) ;; add-table-line : (is-a? area-container<%>)
;; -> (list (union #f string[filename]) string[filename-file-exists?]) ;; -> (list (union #f string[filename]) string[filename-file-exists?])
@ -140,19 +118,39 @@
[backup-file (cadr table-entry)] [backup-file (cadr table-entry)]
[hp (instantiate horizontal-panel% () [hp (instantiate horizontal-panel% ()
(parent area-container) (parent area-container)
(style '(border))
(stretchable-height #f))] (stretchable-height #f))]
[vp (instantiate vertical-panel% () [vp (instantiate vertical-panel% ()
(parent hp))] (parent hp))]
[compare [compare
(make-object button% (string-constant autosave-details) vp (make-object button% (string-constant autosave-details) hp
(lambda (x y) (lambda (x y)
(show-differences table-entry)))] (show-differences table-entry)))]
[recover [recover
(make-object button% (string-constant autosave-recover) vp (make-object button% (string-constant autosave-recover) hp
(lambda (x y) (lambda (x y)
(recover-file area-container hp table-entry)))] (recover-file area-container hp table-entry)))]
[msg1 (make-object message% (or orig-file (string-constant autosave-unknown-filename)) vp)] [msg1-panel (instantiate horizontal-panel% ()
[msg2 (make-object message% (cadr table-entry) vp)]) (parent vp))]
[msg1-label (instantiate message% ()
(parent msg1-panel)
(label (string-constant autosave-original-label)))]
[msg1 (instantiate message% ()
(label (or orig-file (string-constant autosave-unknown-filename)))
(stretchable-width #t)
(parent msg1-panel))]
[msg2-panel (instantiate horizontal-panel% ()
(parent vp))]
[msg2-label (instantiate message% ()
(parent msg2-panel)
(label (string-constant autosave-autosave-label)))]
[msg2 (instantiate message% ()
(label backup-file)
(stretchable-width #t)
(parent msg2-panel))])
(let ([w (max (send msg1-label get-width) (send msg2-label get-width))])
(send msg1-label min-width w)
(send msg2-label min-width w))
(send compare enable orig-file) (send compare enable orig-file)
(void)))) (void))))