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
(require (lib "unitsig.ss")
(lib "class.ss")
(lib "class100.ss")
"sig.ss"
(lib "mred-sig.ss" "mred"))
@ -18,44 +18,75 @@
do-autosave))
(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%
(class100 timer% ()
(class timer%
(inherit start)
(override
[notify
(lambda ()
(when (preferences:get 'framework:autosaving-on?)
(set! objects
(let loop ([list objects])
(if (null? list)
null
(let ([object (weak-box-value (car list))])
(if object
(begin
(send object do-autosave)
(cons (car list) (loop (cdr list))))
(loop (cdr list))))))))
(let ([seconds (preferences:get 'framework:autosave-delay)])
(start (* 1000 seconds) #t)))])
(sequence
(super-init)
(let ([seconds (preferences:get 'framework:autosave-delay)])
(start (* 1000 seconds) #t)))))
(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
(lambda (port)
(write new-name-mapping port))
'truncate
'text)))
(let ([seconds (preferences:get 'framework:autosave-delay)])
(start (* 1000 seconds) #t)))
(super-instantiate ())
(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 register
(lambda (b)
(unless timer
(set! timer (make-object autosave-timer%)))
(set! objects
(let loop ([objects objects])
(cond
[(null? objects) (list (make-weak-box b))]
[else (let ([weak-box (car objects)])
(if (weak-box-value weak-box)
(cons weak-box (loop (cdr objects)))
(loop (cdr objects))))]))))))))
(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
(let loop ([objects objects])
(cond
[(null? objects) (list (make-weak-box b))]
[else (let ([weak-box (car objects)])
(if (weak-box-value weak-box)
(cons weak-box (loop (cdr objects)))
(loop (cdr objects))))])))))))