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

..

Browse Source 
original commit: f479e7bfe56af1eacbe39358458b5c2ce0f70add
This commit is contained in:
Robby Findler 2002-09-02 14:08:39 +00:00
parent 6d1c09f7bd
commit db077574b0
1 changed files with 65 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,7 +1,7 @@
(module autosave mzscheme (module autosave mzscheme
(require (lib "unitsig.ss") (require (lib "unitsig.ss")
(lib "class.ss") (lib "class.ss")
(lib "class100.ss")
"sig.ss" "sig.ss"
(lib "mred-sig.ss" "mred")) (lib "mred-sig.ss" "mred"))
@ -18,44 +18,75 @@
do-autosave)) do-autosave))
(define objects null) (define objects null)
(define autosave-toc
(build-path (find-system-path 'pref-dir)
(case (system-type)
[(windows unix) ".plt-autosave-toc"]
[else "PLT-autosave-toc"])))
(define autosave-toc-save
(build-path (find-system-path 'pref-dir)
(case (system-type)
[(windows unix) ".plt-autosave-toc-save"]
[else "PLT-autosave-toc-save"])))
(define autosave-timer% (define autosave-timer%
(class100 timer% () (class timer%
(inherit start) (inherit start)
(override (define/override (notify)
[notify (when (preferences:get 'framework:autosaving-on?)
(lambda () (let-values ([(new-objects new-name-mapping) (rebuild-object-list)])
(when (preferences:get 'framework:autosaving-on?) (when (file-exists? autosave-toc-save)
(set! objects (delete-file autosave-toc-save))
(let loop ([list objects]) (when (file-exists? autosave-toc)
(if (null? list) (copy-file autosave-toc autosave-toc-save))
null (call-with-output-file autosave-toc
(let ([object (weak-box-value (car list))]) (lambda (port)
(if object (write new-name-mapping port))
(begin 'truncate
(send object do-autosave) 'text)))
(cons (car list) (loop (cdr list)))) (let ([seconds (preferences:get 'framework:autosave-delay)])
(loop (cdr list)))))))) (start (* 1000 seconds) #t)))
(let ([seconds (preferences:get 'framework:autosave-delay)]) (super-instantiate ())
(start (* 1000 seconds) #t)))]) (let ([seconds (preferences:get 'framework:autosave-delay)])
(sequence (start (* 1000 seconds) #t))))
(super-init)
(let ([seconds (preferences:get 'framework:autosave-delay)])
(start (* 1000 seconds) #t)))))
(define (restore-autosave-files/gui)
...)
(define (rebuild-object-list)
(let loop ([orig-objects objects]
[name-mapping null]
[new-objects null])
(if (null? orig-objects)
(values new-objects name-mapping)
(let* ([object-wb (car orig-objects)]
[object (weak-box-value object-wb)])
(if object
(let ([new-filename (send object do-autosave)])
(loop (cdr orig-objects)
(cons (list (send object get-filename)
new-filename))
(cons object-wb new-objects)))
(loop (cdr orig-objects)
name-mapping
new-objects))))))
(define timer #f) (define timer #f)
(define register (define (register b)
(lambda (b) (unless (is-a? b editor<%>)
(unless timer (error 'autosave:register "expected object implemeting editor<%>, got: ~e" b))
(set! timer (make-object autosave-timer%))) (unless timer
(set! objects (set! timer (make-object autosave-timer%)))
(let loop ([objects objects]) (set! objects
(cond (let loop ([objects objects])
[(null? objects) (list (make-weak-box b))] (cond
[else (let ([weak-box (car objects)]) [(null? objects) (list (make-weak-box b))]
(if (weak-box-value weak-box) [else (let ([weak-box (car objects)])
(cons weak-box (loop (cdr objects))) (if (weak-box-value weak-box)
(loop (cdr objects))))])))))))) (cons weak-box (loop (cdr objects)))
(loop (cdr objects))))])))))))