multiple libraries
This commit is contained in:
+199
-23
@@ -11,50 +11,71 @@
|
||||
"translate.rkt"
|
||||
"playlist.rkt"
|
||||
"player.rkt"
|
||||
"libraries.rkt"
|
||||
)
|
||||
|
||||
(provide
|
||||
(all-from-out racket-webview)
|
||||
settings%
|
||||
)
|
||||
(all-from-out racket-webview)
|
||||
settings%
|
||||
)
|
||||
|
||||
(define-runtime-path rkt-gui-dir "gui")
|
||||
|
||||
(define settings%
|
||||
(define library-dlg%
|
||||
(class wv-dialog%
|
||||
(init-field [log-file #f])
|
||||
(init-field [kind #f] [result-cb (λ args #f)]
|
||||
[id (new-id)] [name ""] [local-path ""]
|
||||
[host ""] [prefixes ""])
|
||||
(inherit-field settings icon parent)
|
||||
|
||||
(super-new
|
||||
[html-path "settings.html"]
|
||||
[title "Racket Music Player - Settings"]
|
||||
[icon (build-path rkt-gui-dir "rktplayer.png")]
|
||||
[quit-on-close #f]
|
||||
)
|
||||
[html-path "library-dialog.html"]
|
||||
[title (tr 'settings-library)]
|
||||
[icon (build-path rkt-gui-dir "rktplayer.png")]
|
||||
[quit-on-close #f]
|
||||
)
|
||||
|
||||
(define initialized #f)
|
||||
(define btn-ok #f)
|
||||
(define btn-cancel #f)
|
||||
(define lbl-language #f)
|
||||
(define lbl-name #f)
|
||||
(define lbl-local-path #f)
|
||||
(define btn-browse #f)
|
||||
(define lbl-host #f)
|
||||
(define lbl-prefixes #f)
|
||||
(define div-language #f)
|
||||
(define sel-language #f)
|
||||
|
||||
(define cfg (send settings clone 'settings))
|
||||
(define inp-local-path #f)
|
||||
(define inp-name #f)
|
||||
(define inp-host #f)
|
||||
(define inp-prefixes #f)
|
||||
|
||||
(define/public (set-labels)
|
||||
(send btn-ok set-innerHTML! (tr 'ok))
|
||||
(send btn-cancel set-innerHTML! (tr 'cancel))
|
||||
(send lbl-language set-innerHTML! (tr 'language))
|
||||
(send lbl-name set-innerHTML! (tr 'name))
|
||||
(send lbl-local-path set-innerHTML! (tr 'local-path))
|
||||
(send lbl-host set-innerHTML! (tr 'host))
|
||||
(send lbl-prefixes set-innerHTML! (tr 'prefixes))
|
||||
(send btn-browse set-innerHTML! (tr 'browse))
|
||||
)
|
||||
|
||||
(define (get el)
|
||||
(let ((str (send el get)))
|
||||
(string-trim str)))
|
||||
|
||||
(define/public (select-library)
|
||||
(let* ((music-library (get inp-local-path))
|
||||
(dir (send this choose-dir
|
||||
(tr 'choose-lib-folder)
|
||||
music-library
|
||||
)))
|
||||
(displayln "Directory kiezen")
|
||||
(if (eq? dir 'showing)
|
||||
'done
|
||||
(unless (eq? dir #f)
|
||||
(send inp-local-path set! dir))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/override (page-loaded oke)
|
||||
(unless initialized
|
||||
@@ -62,7 +83,159 @@
|
||||
(set! initialized #t)
|
||||
(set! btn-ok (send this element 'ok))
|
||||
(set! btn-cancel (send this element 'cancel))
|
||||
(set! lbl-name (send this element 'lbl-name))
|
||||
(set! lbl-local-path (send this element 'lbl-local-path))
|
||||
(set! lbl-host (send this element 'lbl-host))
|
||||
(set! lbl-prefixes (send this element 'lbl-prefixes))
|
||||
(set! inp-name (send this element 'name))
|
||||
(set! inp-local-path (send this element 'local-path))
|
||||
(set! btn-browse (send this element 'browse))
|
||||
(set! inp-host (send this element 'host))
|
||||
(set! inp-prefixes (send this element 'prefixes))
|
||||
|
||||
(send inp-name set! name)
|
||||
(send inp-local-path set! local-path)
|
||||
(send inp-host set! host)
|
||||
(send inp-prefixes set! prefixes)
|
||||
|
||||
(send this set-labels)
|
||||
|
||||
(send this bind! 'browse 'click (λ (el evt data)
|
||||
(send this select-library)))
|
||||
|
||||
(send this bind! 'ok 'click (λ (el evt data)
|
||||
(let ((name (get inp-name))
|
||||
(local-path (get inp-local-path))
|
||||
(host (get inp-host))
|
||||
(prefixes (get inp-prefixes)))
|
||||
(result-cb id name local-path host prefixes)
|
||||
(send this close))))
|
||||
(send this bind! 'cancel 'click (λ (el evt data) (send this close)))
|
||||
(send this bind! 'dev 'click (λ args (send this devtools)))
|
||||
)
|
||||
))
|
||||
)
|
||||
)
|
||||
|
||||
(define settings%
|
||||
(class wv-dialog%
|
||||
(init-field [log-file #f])
|
||||
(inherit-field settings icon parent)
|
||||
|
||||
(super-new
|
||||
[html-path "settings.html"]
|
||||
[title (tr 'settings-title)]
|
||||
[icon (build-path rkt-gui-dir "rktplayer.png")]
|
||||
[quit-on-close #f]
|
||||
)
|
||||
|
||||
(define initialized #f)
|
||||
(define btn-ok #f)
|
||||
(define btn-cancel #f)
|
||||
(define btn-add #f)
|
||||
(define btn-edit #f)
|
||||
(define btn-remove #f)
|
||||
(define lbl-language #f)
|
||||
(define lbl-name #f)
|
||||
(define lbl-local-path #f)
|
||||
(define lbl-host #f)
|
||||
(define lbl-prefixes #f)
|
||||
(define lbl-lib #f)
|
||||
(define div-language #f)
|
||||
(define sel-language #f)
|
||||
|
||||
(define libs (new libraries% [settings settings]))
|
||||
|
||||
(define cfg (send settings clone 'settings))
|
||||
|
||||
(define/public (set-labels)
|
||||
(send btn-ok set-innerHTML! (tr 'ok))
|
||||
(send btn-cancel set-innerHTML! (tr 'cancel))
|
||||
(send btn-add set-innerHTML! (tr 'library-add))
|
||||
(send btn-edit set-innerHTML! (tr 'library-edit))
|
||||
(send btn-remove set-innerHTML! (tr 'library-remove))
|
||||
(send lbl-language set-innerHTML! (tr 'language))
|
||||
(send lbl-name set-innerHTML! (tr 'name))
|
||||
(send lbl-local-path set-innerHTML! (tr 'local-path))
|
||||
(send lbl-host set-innerHTML! (tr 'host))
|
||||
(send lbl-prefixes set-innerHTML! (tr 'prefixes))
|
||||
(send lbl-lib set-innerHTML! (tr 'lbl-libary-path))
|
||||
)
|
||||
|
||||
(define/public (update-libraries)
|
||||
(let ((count (send libs count)))
|
||||
(letrec ((f (λ (i)
|
||||
(if (= i count)
|
||||
'()
|
||||
(cons
|
||||
(let* ((id (send libs library-id i))
|
||||
(entry (send libs get-library id))
|
||||
(name (send entry get-name))
|
||||
(local-path (send entry get-local-path))
|
||||
(host (send entry get-host))
|
||||
(tr-attr (if (send entry is-current?)
|
||||
'((class "current"))
|
||||
'((class "none"))))
|
||||
)
|
||||
(list 'tr (append (list (list 'id (format "~a" id)))
|
||||
tr-attr)
|
||||
(list 'td (list '(class "name")) name)
|
||||
(list 'td '((class "path")) local-path)
|
||||
(list 'td '((class "host")) host)))
|
||||
(f (+ i 1)))))))
|
||||
(let* ((tbl (f 0))
|
||||
(el (send this element 'lib-body))
|
||||
(html (if (= count 0)
|
||||
""
|
||||
(apply string-append (map xexpr->string tbl)))))
|
||||
(displayln html)
|
||||
(send el set-innerHTML! html)
|
||||
(send this bind! "table.libraries tr" 'click
|
||||
(lambda (el evt data)
|
||||
(let* ((new-id (string->symbol (send el attr 'id)))
|
||||
(new-lib (send libs get-library new-id))
|
||||
(cur-lib (send libs current-library))
|
||||
)
|
||||
(displayln new-id)
|
||||
(displayln new-lib)
|
||||
(displayln cur-lib)
|
||||
(unless (eq? cur-lib #f)
|
||||
(let ((cur-el (send this element (send cur-lib get-id))))
|
||||
(send cur-el remove-class! 'current)
|
||||
(send cur-lib set-current! #f)))
|
||||
(unless (eq? new-id #f)
|
||||
(let ((new-el (send this element new-id)))
|
||||
(displayln new-el)
|
||||
(displayln (send new-el attr 'id))
|
||||
(send new-el set-attr! '(test "NEE!"))
|
||||
(send new-el add-class! "current")
|
||||
(send new-lib set-current! #t)
|
||||
(send libs update-library new-lib)))
|
||||
)))
|
||||
))))
|
||||
|
||||
(define/public (add-library)
|
||||
(let* ((cb (λ (id name local-path host prefixes)
|
||||
(send libs add-library (new library% [id id]
|
||||
[name name] [local-path local-path]
|
||||
[host host] [prefixes prefixes] [current #f]))
|
||||
(send this update-libraries)))
|
||||
(dlg (new library-dlg% [parent this]
|
||||
[settings (send settings clone 'library-dlg)]
|
||||
[kind 'add] [result-cb cb])))
|
||||
(send dlg show)))
|
||||
|
||||
(define/override (page-loaded oke)
|
||||
(unless initialized
|
||||
(when oke
|
||||
(set! initialized #t)
|
||||
(set! btn-ok (send this element 'ok))
|
||||
(set! btn-cancel (send this element 'cancel))
|
||||
(set! btn-add (send this element 'add))
|
||||
(set! btn-edit (send this element 'edit))
|
||||
(set! btn-remove (send this element 'remove))
|
||||
(set! lbl-language (send this element 'lbl-language))
|
||||
(set! lbl-lib (send this element 'lbl-libary-path))
|
||||
(set! lbl-name (send this element 'lbl-name))
|
||||
(set! lbl-local-path (send this element 'lbl-local-path))
|
||||
(set! lbl-host (send this element 'lbl-host))
|
||||
@@ -75,20 +248,23 @@
|
||||
|
||||
(send this bind! 'sel-lang 'change (λ (el evt data)
|
||||
(let ((lang (string->symbol
|
||||
(format "~a" (hash-ref data 'value (current-lang))))))
|
||||
(format "~a" (hash-ref data 'value (current-lang))))))
|
||||
(set-lang! lang)
|
||||
(send cfg set! 'language lang)
|
||||
(send this set-labels))))
|
||||
|
||||
(send this bind! 'ok 'click (λ args (displayln args)))
|
||||
(send this bind! 'cancel 'click (λ args (displayln args)))
|
||||
(send this bind! 'ok 'click (λ (el evt data) (send this close)))
|
||||
(send this bind! 'cancel 'click (λ (el evt data) (send this close)))
|
||||
(send this bind! 'dev 'click (λ args (send this devtools)))
|
||||
(send this bind! 'add 'click (λ (el evt data) (send this add-library)))
|
||||
(send this bind! 'edit 'click (λ (el evt data) (send this edit-library)))
|
||||
(send this bind! 'remove 'click (λ (el evt data) (send this remove-library)))
|
||||
|
||||
(send this update-libraries)
|
||||
)
|
||||
)
|
||||
|
||||
(info-rktplayer "page loaded"))
|
||||
|
||||
|
||||
(info-rktplayer "page loaded")
|
||||
)
|
||||
|
||||
(begin
|
||||
#t)
|
||||
|
||||
Reference in New Issue
Block a user