From 332d616512b371066342e51afdff8ab55a29df41 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 2 Sep 2002 16:10:15 +0000 Subject: [PATCH] .. original commit: fc91371c44d07fd7bcd75828317f6c01dffe6e08 --- collects/framework/framework.ss | 13 ++- collects/framework/private/autosave.ss | 111 ++++++++++++++++++++----- collects/framework/private/editor.ss | 58 +++++++------ collects/framework/private/sig.ss | 3 +- 4 files changed, 135 insertions(+), 50 deletions(-) diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index d2219578..d54cce88 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -251,7 +251,10 @@ "Hides the preferences dialog.") (autosave:register - ((is-a?/c autosave:autosavable<%>) . -> . void?) + ((and/f (is-a?/c autosave:autosavable<%>) + (is-a?/c editor<%>)) + . -> . + void?) (obj) "Adds \\var{obj} to the list of objects to be autosaved. When it is time" "to autosave, the \\rawscm{do-autosave} method of the object is" @@ -261,7 +264,13 @@ "de-register an object because the autosaver keeps a ``weak'' pointer" "to the object; i.e., the autosaver does not keep an object from" "garbage collection.") - + + (autosave:restore-autosave-files/gui + (-> void?) + () + "Opens a GUI to ask the user about recovering any autosave files" + "left around from crashes and things.") + (exit:frame-exiting (case-> ((union false? (is-a?/c frame%) (is-a?/c dialog%)) diff --git a/collects/framework/private/autosave.ss b/collects/framework/private/autosave.ss index 3d5cd0d1..d6a8cb1a 100644 --- a/collects/framework/private/autosave.ss +++ b/collects/framework/private/autosave.ss @@ -3,7 +3,11 @@ (require (lib "unitsig.ss") (lib "class.ss") "sig.ss" - (lib "mred-sig.ss" "mred")) + (lib "mred-sig.ss" "mred") + (lib "list.ss") + (lib "string-constant.ss" "string-constants") + ;(file "/home/robby/cvs/plt/collects/string-constants/string-constant.ss") + ) (provide autosave@) @@ -11,7 +15,8 @@ (unit/sig framework:autosave^ (import mred^ [exit : framework:exit^] - [preferences : framework:preferences^]) + [preferences : framework:preferences^] + [frame : framework:frame^]) (define autosavable<%> (interface () @@ -19,13 +24,13 @@ (define objects null) - (define autosave-toc + (define autosave-toc-filename (build-path (find-system-path 'pref-dir) (case (system-type) [(windows unix) ".plt-autosave-toc"] [else "PLT-autosave-toc"]))) - (define autosave-toc-save + (define autosave-toc-save-filename (build-path (find-system-path 'pref-dir) (case (system-type) [(windows unix) ".plt-autosave-toc-save"] @@ -37,11 +42,11 @@ (define/override (notify) (when (preferences:get 'framework:autosaving-on?) (let-values ([(new-objects new-name-mapping) (rebuild-object-list)]) - (when (file-exists? autosave-toc-save) - (delete-file autosave-toc-save)) - (when (file-exists? autosave-toc) - (copy-file autosave-toc autosave-toc-save)) - (call-with-output-file autosave-toc + (when (file-exists? autosave-toc-save-filename) + (delete-file autosave-toc-save-filename)) + (when (file-exists? autosave-toc-filename) + (copy-file autosave-toc-filename autosave-toc-save-filename)) + (call-with-output-file autosave-toc-filename (lambda (port) (write new-name-mapping port)) 'truncate @@ -52,9 +57,8 @@ (let ([seconds (preferences:get 'framework:autosave-delay)]) (start (* 1000 seconds) #t)))) - (define (restore-autosave-files/gui) - ...) - + ;; rebuild-object-list : -> (values (listof (weak-box (is-a?/c editor<%>))) + ;; (listof (list (union #f string[filename]) string[filename])) (define (rebuild-object-list) (let loop ([orig-objects objects] [name-mapping null] @@ -64,20 +68,44 @@ (let* ([object-wb (car orig-objects)] [object (weak-box-value object-wb)]) (if object - (let ([new-filename (send object do-autosave)]) + (let* ([new-filename (send object do-autosave)] + [tmp-box (box #f)] + [filename (send object get-filename tmp-box)]) + (printf "autosave ~s to ~s\n" filename new-filename) (loop (cdr orig-objects) - (cons (list (send object get-filename) - new-filename)) + (if new-filename + (cons (list (and (not (unbox tmp-box)) filename) + new-filename) + name-mapping) + name-mapping) (cons object-wb new-objects))) (loop (cdr orig-objects) name-mapping 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 (register b) - (unless (is-a? b editor<%>) - (error 'autosave:register "expected object implemeting editor<%>, got: ~e" b)) (unless timer (set! timer (make-object autosave-timer%))) (set! objects @@ -87,6 +115,49 @@ [else (let ([weak-box (car objects)]) (if (weak-box-value weak-box) (cons weak-box (loop (cdr objects))) - (loop (cdr objects))))]))))))) - - + (loop (cdr objects))))])))) + + ;; restore-autosave-files/gui : -> void + ;; opens a frame that lists the autosave files that have changed. + (define (restore-autosave-files/gui) + (when (file-exists? autosave-toc-filename) + (let* ([table (call-with-input-file autosave-toc-filename read)] + ;; assume that the autosave file was deleted due to the file being saved + [filtered-table + (filter (lambda (x) (file-exists? (cadr x))) table)]) + (unless (null? filtered-table) + (let ([f (make-object frame:basic% (string-constant recover-autosave-files-frame-title) #f 400 400)]) + (for-each (add-table-line f) filtered-table) + (send f show #t)))))) + + ;; add-table-line : (is-a? area-container<%>) + ;; -> (list (union #f string[filename]) string[filename-file-exists?]) + ;; -> void + ;; adds in a line to the overview table showing this pair of files. + (define (add-table-line area-container) + (lambda (table-entry) + (let* ([orig-file (car table-entry)] + [backup-file (cadr table-entry)] + [hp (instantiate horizontal-panel% () + (parent area-container) + (stretchable-height #f))] + [vp (instantiate vertical-panel% () + (parent hp))] + [compare + (make-object button% (string-constant autosave-details) vp + (lambda (x y) + (show-differences table-entry)))] + [recover + (make-object button% (string-constant autosave-recover) vp + (lambda (x y) + (recover-file area-container hp table-entry)))] + [msg1 (make-object message% (or orig-file (string-constant autosave-unknown-filename)) vp)] + [msg2 (make-object message% (cadr table-entry) vp)]) + (send compare enable orig-file) + (void)))) + + (define (show-differences table-entry) + (void)) + + (define (recover-file parent child table-entry) + (void))))) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 6f572107..9ca51fc6 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -454,33 +454,37 @@ (public autosave? do-autosave remove-autosave) [define autosave? (lambda () do-autosave?)] [define (do-autosave) - (when (and (autosave?) - (not auto-save-error?) - (is-modified?) - (or (not auto-saved-name) - auto-save-out-of-date?)) - (let* ([orig-name (get-filename)] - [old-auto-name auto-saved-name] - [auto-name (path-utils:generate-autosave-name orig-name)]) - (with-handlers ([not-break-exn? - (lambda (exn) - (message-box - (string-constant warning) - (string-append - (format (string-constant error-autosaving) - (or orig-name (string-constant untitled))) - "\n" - (string-constant autosaving-turned-off) - "\n\n" - (if (exn? exn) - (exn-message exn) - (format "~s" exn)))) - (set! auto-save-error? #t))]) - (save-file auto-name 'copy #f) - (when old-auto-name - (delete-file old-auto-name)) - (set! auto-saved-name auto-name) - (set! auto-save-out-of-date? #f))))] + (cond + [(and (autosave?) + (not auto-save-error?) + (is-modified?) + (or (not auto-saved-name) + auto-save-out-of-date?)) + (let* ([orig-name (get-filename)] + [old-auto-name auto-saved-name] + [auto-name (path-utils:generate-autosave-name orig-name)]) + (with-handlers ([not-break-exn? + (lambda (exn) + (message-box + (string-constant warning) + (string-append + (format (string-constant error-autosaving) + (or orig-name (string-constant untitled))) + "\n" + (string-constant autosaving-turned-off) + "\n\n" + (if (exn? exn) + (exn-message exn) + (format "~s" exn)))) + (set! auto-save-error? #t) + #f)]) + (save-file auto-name 'copy #f) + (when old-auto-name + (delete-file old-auto-name)) + (set! auto-saved-name auto-name) + (set! auto-save-out-of-date? #f) + auto-name))] + [else auto-saved-name])] [define remove-autosave (lambda () (when auto-saved-name diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index c5c45292..a946a743 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -193,7 +193,8 @@ (define-signature framework:autosave-class^ (autosavable<%>)) (define-signature framework:autosave-fun^ - (register)) + (register + restore-autosave-files/gui)) (define-signature framework:autosave^ ((open framework:autosave-class^) (open framework:autosave-fun^)))