; #lang mzscheme
(module install mzscheme
; This tile doesn't "provide" anything, but merely installs a stub file
; in the installed-teachpacks directory which invokes the real
; "tiles.ss".
  (require (lib "file.ss"))

  (define world-module-spec '(planet "sb-world.ss" ("sbloch" "sb-world.plt" 1 0)))
  
  (define destdir (build-path (find-system-path 'addon-dir)
                              (string->path (version))
                              (string->path "collects")
                              (string->path "installed-teachpacks")
                              ))
  
  (define (makefile filename module-spec)
    (let ((destfile (build-path destdir (string->path filename)))
          (require-stmt `(require ,module-spec))
          (provide-stmt `(provide (all-from ,module-spec))))
      (if (file-exists? destfile)
          (display "Teachpack file already exists.")
          (begin
            (unless (directory-exists? destdir)   
              (make-directory* destdir))
            (if (member 'write (file-or-directory-permissions destdir))
                (begin
                  (with-output-to-file destfile
                    (lambda ()
                      (begin (display "(module sb-world mzscheme")
                             (newline)
                             (write require-stmt)
                             (newline)
                             (write provide-stmt)
                             (newline)
			     (display ")")
			     (newline))))
                  (display (format "Wrote file ~s to installed-teachpacks directory~n" filename)))
                (display (format "Unable to write file ~s to installed-teachpacks directory~n" filename)))
            )
          )
      )
    )
  (makefile "sb-world.ss" world-module-spec)
;  (makefile "sb-world.ss" '(planet "sb-world.ss" ("sbloch" "sb-world.plt" 1 0)))
)