#lang scheme/gui

(require "planet-utils.ss")
(require mrlib/hierlist)
(require (only-in mrlib/aligned-pasteboard horizontal-pasteboard% aligned-editor-snip%))
(require embedded-gui)

(define spacer%
  (class embedded-message%
     (init-field length)
     (super-new [label (make-string length #\space)])))

#;
(define (scrollable% parent)
  (class parent
    ;; (override do-get-graphical-min-size)
    (super-new)
    (define/override (alignment) #f)
    #;
    (define/override (do-get-graphical-min-size) 10)))

(define frame (new frame% [label "Planet Manager"]
                   [width 400]
                   [height 500]))

(define panel1 (new vertical-pane% [parent frame]))

(define package-panel (new hierarchical-list% [parent panel1]))

#;
(define package-panel (new vertical-pane% [parent panel1]
                           [stretchable-height #f]))

(let ([all (get-all-planet-packages)])
  (define (update)
    (send package-panel show #f)
    (for-each (lambda (item)
                (send package-panel delete-item item))
              (send package-panel get-items))
    (hash-for-each all
                   (lambda (category packages)
                     (let ([sub-list (send package-panel new-list)])
                       (send sub-list open)
                       (send (send sub-list get-editor) insert category)
                       (for-each (lambda (package)
                                   (define (setup-row place)
                                     (new embedded-message% [parent place]
                                          [label (planet-package-name package)])
                                     (new spacer% [length 5] [parent place])
                                     (if (installed? package)
                                       (new embedded-text-button% [parent place]
                                            [label "uninstall"]
                                            [callback (lambda x
                                                        (begin
                                                          (uninstall-planet-package package)
                                                          (update)))])
                                       (new embedded-text-button% [parent place]
                                            [label "install"]
                                            [callback (lambda x
                                                        (begin
                                                          (printf "Installing ~a\n"
                                                                  (planet-package-name package))
                                                          (install-planet-package package)
                                                          (update)
                                                          (printf "Done installing\n")))])))

                                   (let* ([editor (send (send sub-list new-item) get-editor)]
                                          [align (new aligned-pasteboard%)]
                                          [stretch (new editor-snip% [editor align])])
                                     (send editor insert stretch)
                                     (setup-row (new horizontal-alignment% [parent align]))))
                                 packages)
                       (send sub-list close))))
    (send package-panel show #t))
  (update)

  #;
  (hash-for-each all
                 (lambda (category packages)
                   (define box (new group-box-panel%
                                    [label category]
                                    [parent package-panel]
                                    ))

                   (define nothing (new frame% [label "nothing"]))
                   #;
                   (define top (new (scrollable% vertical-pane%) [parent nothing]
                                    ))

                   (new list-box% [label "stuff"] [parent box]
                        [choices (map (lambda (x) (planet-package-name x))
                                      packages)])
                   #;
                   (for-each (lambda (package)
                               (new button% [parent box] [label "check"])
                               #;
                               (new check-box% [parent box] [label (planet-package-name package)]) )
                             packages))))

(send frame show #t)