(module path-utils mzscheme
  (require (lib "unitsig.ss")
	   "sig.ss"
	   (lib "mred-sig.ss" "mred"))
  
  (provide path-utils@)
  
  (define path-utils@
    (unit/sig framework:path-utils^
      (import)
      
      (define (generate-autosave-name name)
        (let-values ([(base name dir?)
                      (if name
                          (split-path name)
                          (values (find-system-path 'doc-dir)
                                  (bytes->path #"mredauto")
                                  #f))])
          (let* ([base (if (path? base)
                           base
                           (current-directory))]
                 [path (if (relative-path? base)
                           (build-path (current-directory) base)
                           base)])
            (let loop ([n 1])
              (let* ([numb (string->bytes/utf-8 (number->string n))]
                     [new-name
                      (build-path path
                                  (if (eq? (system-type) 'windows)
                                      (bytes->path
                                       (bytes-append (regexp-replace #rx#"\\..*$" 
                                                                     (path->bytes name)
                                                                     #"")
                                                     #"."
                                                     numb))
                                      (bytes->path
                                       (bytes-append #"#"
                                                     (path->bytes name)
                                                     #"#"
                                                     numb
                                                     #"#"))))])
                (if (file-exists? new-name)
                    (loop (add1 n))
                    new-name))))))
      
      (define (generate-backup-name full-name)
        (let-values ([(pre-base name dir?) (split-path full-name)])
          (let ([base (if (path? pre-base)
                          pre-base
                          (current-directory))])
            (let ([name-bytes (path->bytes name)])
              (cond
                [(and (eq? (system-type) 'windows)
                      (regexp-match #rx#"(.*)\\.[^.]*" name-bytes))
                 =>
                 (λ (m)
                   (build-path base (bytes->path (bytes-append (cadr m) #".bak"))))]
                [(eq? (system-type) 'windows)
                 (build-path base (bytes->path (bytes-append name-bytes #".bak")))]
                [else
                 (build-path base (bytes->path (bytes-append name-bytes #"~")))]))))))))

