#lang scheme/gui
(require planet/util)
(provide create-planet-info make-planet-archive)
; dialog
;; must find some way of just getting the from the planet library
;; legal-categories : (listof symbol)
(define legal-categories
  '(devtools net media xml datastructures io scientific
            system ui metaprogramming planet misc))
(define legal-repositories
  '("4.x" "3xx"))
;; label-string / data pairs mapping for categories list-box
(define categories-labelstring-data-mapping 
  (map (lambda (cat) (list (symbol->string cat) cat) ) legal-categories))
(define repositories-labelstring-data-mapping 
  (map (lambda (cat) (list cat cat) ) legal-repositories))


(define (create-planet-info file)
  (define f (new dialog% [label "make planet package"][height 300][width 300]))
  (define-values (file-path file-name pdir?) (split-path file))
  (define info-template (lambda args (apply format "#lang setup/infotab
(define version \"~a\")
(define name \"~a\")
(define blurb  '(\"~a\"))
(define primary-file \"~a\")
(define categories '~v)
(define repositories '~v)
" args)))
  (define name (new text-field% [label "Name"] [parent f]))
  (define version (new text-field% [label "Version"] [parent f]))
  (define blurb (new text-field% [label "Blurb"] [parent f]))
  (define categories 
    (new list-box% 
        [label "categories"] 
        [parent f] [style '(extended)]
        [choices null]))
  ;;a list consisting of some subset of the strings "4.x" and "3xx".
  (define repositories (new list-box% [label "repositories"] [parent f] [style '(extended)]
                           [choices '()]))
  
  (define (info-file o) 
    (display (info-template 
              (send name get-value) 
              (send version get-value) 
              (send blurb get-value)
              file-name
              (map (lambda (s)  (send categories get-data s))
                  (send categories get-selections))
              (map (lambda (s)  (send repositories get-data s))
                  (send repositories get-selections))
              
              
              ) o))
  (define cb (lambda (b v)
               (call-with-output-file (build-path file-path "info.ss") info-file #:mode 'text #:exists 'replace)
               (send f show #f)
               ))
  (define b (new button% [label "pack PLT"] [callback cb] [parent f]))
  
  ;poulate categories list-
  (for-each (lambda (ss) (send categories append (car ss)(cadr ss))) categories-labelstring-data-mapping)
  (for-each (lambda (ss) (send repositories append (car ss)(cadr ss))) repositories-labelstring-data-mapping)
  
  (let ((infosspath (build-path file-path "info.ss")))
    (when (file-exists? infosspath) 
      (delete-file infosspath)))
  (send f show #t)
  (list file-path (build-path file-path (string-append (path->string file-name) ".plt"))))
;;end