#lang scheme/base
(require (lib "tool.ss" "drscheme")
mred
mzlib/unit
scheme/class)
(provide tool@)
(define tool@
(unit
(import drscheme:tool^)
(export drscheme:tool-exports^)
(define phase1 void)
(define phase2 void)
(define drsync-frame-mixin
(mixin (drscheme:unit:frame<%>) ()
(define file/timestamps (make-hash))
(define mem-timestamp
(lambda (path)
(hash-ref file/timestamps (path->string path) #f)))
(define set!-mem-timestamp
(lambda (path stamp)
(hash-set! file/timestamps (path->string path) stamp)))
(define file-path
(lambda (editor)
(send editor get-filename)))
(define file-modified?
(lambda (editor)
(send editor is-modified?)))
(define fs-timestamp
(lambda (path)
(with-handlers
((exn:fail:filesystem? (lambda (exc) -1)))
(file-or-directory-modify-seconds path))))
(define load-file
(lambda (editor)
(with-handlers
((exn:fail? (lambda (exc) #f)))
(send editor load-file #f (send editor get-file-format) #t))))
(define save-file
(lambda (editor)
(with-handlers
((exn:fail? (lambda (exc) #f)))
(send editor save-file #f (send editor get-file-format) #t))))
(define file-start-position
(lambda (editor)
(send editor get-start-position)))
(define/override (on-activate active?)
(super on-activate active?)
(if active? (handle-activation) (handle-deactivation)))
(define handle-activation
(lambda ()
(each-tab
(lambda (editor) (file-path editor))
(lambda (editor)
(let* ([path (file-path editor)]
[mem/timestamp (mem-timestamp path)]
[fs/timestamp (fs-timestamp path)])
(when (and mem/timestamp (> fs/timestamp mem/timestamp))
(begin
(send editor begin-edit-sequence)
(let ([pos (file-start-position editor)])
(when (load-file editor) (send editor set-position pos pos)))
(send editor end-edit-sequence))))))))
(define handle-deactivation
(lambda ()
(each-tab
(lambda (editor) (file-path editor))
(lambda (editor)
(when (file-modified? editor) (save-file editor))
(let* ([path (file-path editor)]
[mem/timestamp (mem-timestamp path)]
[fs/timestamp (fs-timestamp path)])
(when (or (not mem/timestamp) (> fs/timestamp mem/timestamp))
(set!-mem-timestamp path fs/timestamp)))))))
(define each-tab
(lambda (predicate? action)
(for-each
(lambda (tab)
(let ([editor (send tab get-defs)])
(when (predicate? editor) (action editor))))
(send this get-tabs))))
(super-new)))
(drscheme:get/extend:extend-unit-frame drsync-frame-mixin)))