From cd3b42aca366cca5003430c3106825a0480d5a8d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 28 Sep 2011 17:05:45 -0500 Subject: [PATCH] fix problems with the autosave recovery gui and add a drdr test for it original commit: c8cbe81e51404e0c650bbedc3bdb901fd5636f9e --- collects/framework/main.rkt | 5 ++ collects/framework/private/autosave.rkt | 63 +++++++++++++++---------- collects/framework/private/sig.rkt | 3 +- 3 files changed, 46 insertions(+), 25 deletions(-) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index 0a5e58e2..5b23f479 100644 --- a/collects/framework/main.rkt +++ b/collects/framework/main.rkt @@ -367,6 +367,11 @@ ``weak'' pointer to the object; i.e., the autosaver does not keep an object from garbage collection.}) + (thing-doc + autosave:toc-path + path? + @{The path to the a table-of-contents file for the autosave files that DrRacket has created.}) + (proc-doc/names autosave:restore-autosave-files/gui (-> void?) diff --git a/collects/framework/private/autosave.rkt b/collects/framework/private/autosave.rkt index bb165152..3380d5bc 100644 --- a/collects/framework/private/autosave.rkt +++ b/collects/framework/private/autosave.rkt @@ -25,17 +25,17 @@ (define objects null) - (define autosave-toc-filename + (define toc-path (build-path (find-system-path 'pref-dir) (case (system-type) - [(unix) ".plt-autosave-toc"] - [else "PLT-autosave-toc"]))) + [(unix) ".plt-autosave-toc.rktd"] + [else "PLT-autosave-toc.rktd"]))) (define autosave-toc-save-filename (build-path (find-system-path 'pref-dir) (case (system-type) - [(unix) ".plt-autosave-toc-save"] - [else "PLT-autosave-toc-save"]))) + [(unix) ".plt-autosave-toc-save.rktd"] + [else "PLT-autosave-toc-save.rktd"]))) (define autosave-timer% (class timer% @@ -49,9 +49,9 @@ (set! last-name-mapping new-name-mapping) (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 + (when (file-exists? toc-path) + (copy-file toc-path autosave-toc-save-filename)) + (call-with-output-file toc-path (λ (port) (write new-name-mapping port)) #:exists 'truncate @@ -78,8 +78,11 @@ [filename (send object get-filename tmp-box)]) (loop (cdr orig-objects) (if new-filename - (cons (list (and (not (unbox tmp-box)) filename) - new-filename) + (cons (list (and (not (unbox tmp-box)) + filename + (path->bytes filename)) + (and new-filename + (path->bytes new-filename))) name-mapping) name-mapping) (cons object-wb new-objects))) @@ -88,6 +91,17 @@ new-objects)))))) (define timer #f) + ;; when the autosave delay is changed then we + ;; trigger an autosave right away and let the + ;; callback trigger the next one at the right interval + (preferences:add-callback + 'framework:autosave-delay + (λ (k v) + (when timer + (send timer stop) + (send timer start 0 #t)))) + + (define (register b) (unless timer @@ -108,22 +122,23 @@ ;; main : -> void ;; start everything going (define (main) - (when (file-exists? autosave-toc-filename) + (when (file-exists? toc-path) ;; Load table from file, and check that the file was not corrupted (let* ([table (let ([v (with-handlers ([exn:fail? (λ (x) null)]) - (call-with-input-file autosave-toc-filename read))] - [path? (λ (x) - (and (string? x) - (absolute-path? x)))]) + (call-with-input-file toc-path read))]) (if (and (list? v) (andmap (λ (i) (and (list? i) (= 2 (length i)) (or (not (car i)) - (path? (car i))) - (path? (cadr i)))) + (bytes? (car i))) + (bytes? (cadr i)))) v)) - v + (map (λ (ent) (list (if (bytes? (list-ref ent 0)) + (bytes->path (list-ref ent 0)) + #f) + (bytes->path (list-ref ent 1)))) + v) null))] ;; assume that the autosave file was deleted due to the file being saved [filtered-table @@ -191,7 +206,7 @@ (parent msg1-panel) (label (string-constant autosave-original-label:)))] [msg1 (new message% - (label (or orig-file (string-constant autosave-unknown-filename))) + (label (if orig-file (path->string orig-file) (string-constant autosave-unknown-filename))) (stretchable-width #t) (parent msg1-panel))] [msg2-panel (new horizontal-panel% @@ -200,7 +215,7 @@ (parent msg2-panel) (label (string-constant autosave-autosave-label:)))] [msg2 (new message% - (label backup-file) + (label (path->string backup-file)) (stretchable-width #t) (parent msg2-panel))] [details @@ -261,8 +276,8 @@ ;; show-files : (list (union #f string[filename]) string) -> void (define (show-files table-entry) - (let ([file1 (car table-entry)] - [file2 (cadr table-entry)]) + (let ([file1 (list-ref table-entry 0)] + [file2 (list-ref table-entry 1)]) (define frame (make-object show-files-frame% (if file1 (string-constant autosave-compare-files) @@ -277,12 +292,12 @@ (add-file-viewer file2 hp (string-constant autosave-autosave-label)) (send frame show #t))) - ;; add-file-viewer : string[filename] -> void + ;; add-file-viewer : path? -> void (define (add-file-viewer filename parent label) (define vp (make-object vertical-panel% parent)) (define t (make-object show-files-text%)) (define msg1 (make-object message% label vp)) - (define msg2 (make-object message% filename vp)) + (define msg2 (make-object message% (path->string filename) vp)) (define ec (make-object editor-canvas% vp t)) (send t load-file filename) (send t hide-caret #t) diff --git a/collects/framework/private/sig.rkt b/collects/framework/private/sig.rkt index 0abac09b..9f432003 100644 --- a/collects/framework/private/sig.rkt +++ b/collects/framework/private/sig.rkt @@ -97,7 +97,8 @@ (define-signature autosave-class^ (autosavable<%>)) (define-signature autosave^ extends autosave-class^ - (register + (toc-path + register restore-autosave-files/gui)) (define-signature exit-class^