Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.
This commit is contained in:
@@ -0,0 +1,800 @@
|
||||
#lang racket
|
||||
|
||||
(require racket-webview
|
||||
racket/runtime-path
|
||||
racket/gui
|
||||
racket-sprintf
|
||||
open-app
|
||||
xml
|
||||
(prefix-in upnp: racket-upnp)
|
||||
"../misc/utils.rkt"
|
||||
"translate.rkt"
|
||||
"../play/playlist.rkt"
|
||||
"../play/base/player.rkt"
|
||||
"../library/libraries-config.rkt"
|
||||
"../library/library-factory.rkt"
|
||||
"../play/base/renderer.rkt"
|
||||
)
|
||||
|
||||
(provide
|
||||
(all-from-out racket-webview)
|
||||
settings%
|
||||
)
|
||||
|
||||
(define-runtime-path rkt-gui-dir "html")
|
||||
|
||||
(define library-dlg%
|
||||
(class wv-dialog%
|
||||
(init-field [kind 'filesystem] [result-cb (λ args #f)]
|
||||
[id (new-id)] [name ""] [local-path ""]
|
||||
[host ""] [item-limit 100]
|
||||
[kind-editable? #t])
|
||||
(inherit-field settings icon parent)
|
||||
|
||||
(super-new
|
||||
[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-name #f)
|
||||
(define lbl-kind #f)
|
||||
(define lbl-local-path #f)
|
||||
(define btn-browse #f)
|
||||
(define lbl-media-server #f)
|
||||
(define lbl-media-server-root #f)
|
||||
(define lbl-media-server-item-limit #f)
|
||||
(define btn-refresh-media-servers #f)
|
||||
(define btn-media-server-root-up #f)
|
||||
(define div-filesystem-fields #f)
|
||||
(define div-media-server-fields #f)
|
||||
(define txt-media-server-root #f)
|
||||
(define sel-library-kind #f)
|
||||
(define sel-media-server #f)
|
||||
(define sel-media-server-container #f)
|
||||
(define inp-local-path #f)
|
||||
(define inp-name #f)
|
||||
(define inp-media-server-item-limit #f)
|
||||
(define media-servers '())
|
||||
(define media-server-containers '())
|
||||
(define media-server-root-id
|
||||
(if (and (eq? kind 'media-server)
|
||||
(not (string=? local-path "")))
|
||||
local-path
|
||||
"0"))
|
||||
(define media-server-root-path '())
|
||||
(define media-server-root-parents '())
|
||||
(define media-server-root-request 0)
|
||||
|
||||
(define/public (set-labels)
|
||||
(send btn-ok set-innerHTML! (tr 'ok))
|
||||
(send btn-cancel set-innerHTML! (tr 'cancel))
|
||||
(send lbl-name set-innerHTML! (tr 'name))
|
||||
(send lbl-kind set-innerHTML! (tr 'library-kind))
|
||||
(send lbl-local-path set-innerHTML! (tr 'local-path))
|
||||
(send lbl-media-server set-innerHTML! (tr 'media-servers))
|
||||
(send lbl-media-server-root
|
||||
set-innerHTML!
|
||||
(tr 'media-server-root))
|
||||
(send lbl-media-server-item-limit
|
||||
set-innerHTML!
|
||||
(tr 'media-server-item-limit))
|
||||
(send btn-browse set-innerHTML! (tr 'browse))
|
||||
(send btn-refresh-media-servers set-innerHTML! (tr 'refresh))
|
||||
(send btn-media-server-root-up set-innerHTML! (tr 'up))
|
||||
)
|
||||
|
||||
(define/private (media-server-label server)
|
||||
(format "~a (~a)"
|
||||
(upnp:media-server-name server)
|
||||
(upnp:media-server-address server)))
|
||||
|
||||
(define/private (update-media-servers!)
|
||||
(let* ((items
|
||||
(if (null? media-servers)
|
||||
(list
|
||||
(list -1
|
||||
(tr 'no-media-servers)))
|
||||
(for/list ((server
|
||||
(in-list media-servers))
|
||||
(idx (in-naturals)))
|
||||
(list idx
|
||||
(media-server-label server)))))
|
||||
(selected-idx
|
||||
(or
|
||||
(for/first ((server (in-list media-servers))
|
||||
(idx (in-naturals))
|
||||
#:when
|
||||
(member host
|
||||
(filter
|
||||
values
|
||||
(list
|
||||
(upnp:upnp-device-udn server)
|
||||
(upnp:media-server-name server)
|
||||
(upnp:media-server-address server)))))
|
||||
idx)
|
||||
(if (null? media-servers)
|
||||
-1
|
||||
0))))
|
||||
(send sel-media-server
|
||||
set-options!
|
||||
items
|
||||
selected-idx)))
|
||||
|
||||
(define/public (refresh-media-servers)
|
||||
(set! media-servers '())
|
||||
(update-media-servers!)
|
||||
(send btn-refresh-media-servers
|
||||
set-innerHTML!
|
||||
(tr 'searching))
|
||||
(void
|
||||
(thread
|
||||
(lambda ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-rktplayer
|
||||
"Could not query UPnP media servers: ~a"
|
||||
(exn-message exception))
|
||||
(set! media-servers '())
|
||||
(update-media-servers!)
|
||||
(set! media-server-containers '())
|
||||
(update-media-server-root!)
|
||||
(send btn-refresh-media-servers
|
||||
set-innerHTML!
|
||||
(tr 'refresh)))))
|
||||
(set! media-servers
|
||||
(upnp:query-media-servers))
|
||||
(update-media-servers!)
|
||||
(load-media-server-root!)
|
||||
(send btn-refresh-media-servers
|
||||
set-innerHTML!
|
||||
(tr 'refresh)))))))
|
||||
|
||||
(define/private (selected-media-server)
|
||||
(let* ((idx
|
||||
(string->number
|
||||
(get sel-media-server))))
|
||||
(and idx
|
||||
(>= idx 0)
|
||||
(< idx (length media-servers))
|
||||
(list-ref media-servers idx))))
|
||||
|
||||
(define/private (current-library-kind)
|
||||
(string->symbol
|
||||
(get sel-library-kind)))
|
||||
|
||||
(define/private (update-library-kind!)
|
||||
(case (current-library-kind)
|
||||
((filesystem)
|
||||
(send div-filesystem-fields display 'block)
|
||||
(send div-media-server-fields display 'none))
|
||||
((media-server)
|
||||
(send div-filesystem-fields display 'none)
|
||||
(send div-media-server-fields display 'block))))
|
||||
|
||||
(define/private (media-server-root-label)
|
||||
(if (null? media-server-root-path)
|
||||
(if (string=? media-server-root-id "0")
|
||||
"/"
|
||||
(format "~a" media-server-root-id))
|
||||
(string-append
|
||||
"/"
|
||||
(string-join
|
||||
media-server-root-path
|
||||
" / "))))
|
||||
|
||||
(define/private (update-media-server-root!
|
||||
[status #f])
|
||||
(let ((items
|
||||
(cond
|
||||
(status
|
||||
(list
|
||||
(list -1 status)))
|
||||
((null? media-server-containers)
|
||||
(list
|
||||
(list -1
|
||||
(tr 'no-media-server-containers))))
|
||||
(else
|
||||
(cons
|
||||
(list -1
|
||||
(tr 'select-media-server-container))
|
||||
(for/list
|
||||
((container
|
||||
(in-list media-server-containers))
|
||||
(idx (in-naturals)))
|
||||
(list
|
||||
idx
|
||||
(upnp:media-entry-title
|
||||
container))))))))
|
||||
(send txt-media-server-root
|
||||
set-innerHTML!
|
||||
(media-server-root-label))
|
||||
(send sel-media-server-container
|
||||
set-options!
|
||||
items
|
||||
-1)))
|
||||
|
||||
(define/private (load-media-server-root!)
|
||||
(set! media-server-root-request
|
||||
(add1 media-server-root-request))
|
||||
(let ((request media-server-root-request)
|
||||
(server (selected-media-server))
|
||||
(container-id media-server-root-id))
|
||||
(set! media-server-containers '())
|
||||
(update-media-server-root!
|
||||
(tr 'searching))
|
||||
(if server
|
||||
(void
|
||||
(thread
|
||||
(lambda ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-rktplayer
|
||||
"Could not browse UPnP media-server container ~a: ~a"
|
||||
container-id
|
||||
(exn-message exception))
|
||||
(when (= request
|
||||
media-server-root-request)
|
||||
(set! media-server-containers '())
|
||||
(update-media-server-root!)))))
|
||||
(let ((containers
|
||||
(filter
|
||||
(lambda (entry)
|
||||
(and
|
||||
(upnp:media-container? entry)
|
||||
(string?
|
||||
(upnp:media-entry-id entry))))
|
||||
(upnp:media-server-browse
|
||||
server
|
||||
container-id
|
||||
#:count
|
||||
(current-media-server-item-limit)))))
|
||||
(when (= request
|
||||
media-server-root-request)
|
||||
(set! media-server-containers
|
||||
containers)
|
||||
(update-media-server-root!)))))))
|
||||
(update-media-server-root!))))
|
||||
|
||||
(define/private (reset-media-server-root!)
|
||||
(set! media-server-root-id "0")
|
||||
(set! media-server-root-path '())
|
||||
(set! media-server-root-parents '())
|
||||
(load-media-server-root!))
|
||||
|
||||
(define/private (open-media-server-container!)
|
||||
(let ((idx
|
||||
(string->number
|
||||
(get sel-media-server-container))))
|
||||
(when (and idx
|
||||
(>= idx 0)
|
||||
(< idx
|
||||
(length media-server-containers)))
|
||||
(let ((container
|
||||
(list-ref media-server-containers
|
||||
idx)))
|
||||
(set! media-server-root-parents
|
||||
(cons
|
||||
(list media-server-root-id
|
||||
media-server-root-path)
|
||||
media-server-root-parents))
|
||||
(set! media-server-root-id
|
||||
(upnp:media-entry-id
|
||||
container))
|
||||
(set! media-server-root-path
|
||||
(append
|
||||
media-server-root-path
|
||||
(list
|
||||
(upnp:media-entry-title
|
||||
container))))
|
||||
(load-media-server-root!)))))
|
||||
|
||||
(define/private (media-server-root-up!)
|
||||
(cond
|
||||
((not
|
||||
(null? media-server-root-parents))
|
||||
(let ((parent
|
||||
(car media-server-root-parents)))
|
||||
(set! media-server-root-id
|
||||
(car parent))
|
||||
(set! media-server-root-path
|
||||
(cadr parent))
|
||||
(set! media-server-root-parents
|
||||
(cdr media-server-root-parents))
|
||||
(load-media-server-root!)))
|
||||
((not
|
||||
(string=? media-server-root-id "0"))
|
||||
(reset-media-server-root!))))
|
||||
|
||||
(define (get el)
|
||||
(let ((str (send el get)))
|
||||
(string-trim str)))
|
||||
|
||||
(define/private (current-media-server-item-limit)
|
||||
(let ((value
|
||||
(send inp-media-server-item-limit get)))
|
||||
(if (exact-positive-integer? value)
|
||||
value
|
||||
100)))
|
||||
|
||||
(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
|
||||
(when oke
|
||||
(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-kind (send this element 'lbl-kind))
|
||||
(set! lbl-local-path (send this element 'lbl-local-path))
|
||||
(set! lbl-media-server (send this element 'lbl-media-server))
|
||||
(set! lbl-media-server-root
|
||||
(send this element
|
||||
'lbl-media-server-root))
|
||||
(set! lbl-media-server-item-limit
|
||||
(send this element
|
||||
'lbl-media-server-item-limit))
|
||||
(set! div-filesystem-fields
|
||||
(send this element
|
||||
'filesystem-fields))
|
||||
(set! div-media-server-fields
|
||||
(send this element
|
||||
'media-server-fields))
|
||||
(set! txt-media-server-root
|
||||
(send this element
|
||||
'media-server-root))
|
||||
(set! sel-library-kind
|
||||
(send this element
|
||||
'selected-library-kind))
|
||||
(set! sel-media-server
|
||||
(send this element
|
||||
'selected-media-server))
|
||||
(set! sel-media-server-container
|
||||
(send this element
|
||||
'selected-media-server-container))
|
||||
(set! inp-name (send this element 'name))
|
||||
(set! inp-local-path (send this element 'local-path))
|
||||
(set! inp-media-server-item-limit
|
||||
(send this element
|
||||
'media-server-item-limit))
|
||||
(set! btn-browse (send this element 'browse))
|
||||
(set! btn-refresh-media-servers
|
||||
(send this element
|
||||
'refresh-media-servers))
|
||||
(set! btn-media-server-root-up
|
||||
(send this element
|
||||
'media-server-root-up))
|
||||
|
||||
(send inp-name set! name)
|
||||
(send inp-local-path set! local-path)
|
||||
(send inp-media-server-item-limit
|
||||
set!
|
||||
(format "~a" item-limit))
|
||||
(send sel-library-kind
|
||||
set-options!
|
||||
(list
|
||||
(list 'filesystem
|
||||
(tr 'filesystem))
|
||||
(list 'media-server
|
||||
(tr 'media-server)))
|
||||
kind)
|
||||
(unless kind-editable?
|
||||
(send sel-library-kind
|
||||
set-attr!
|
||||
'((disabled "disabled"))))
|
||||
|
||||
(send this set-labels)
|
||||
(update-library-kind!)
|
||||
(update-media-server-root!)
|
||||
|
||||
(send sel-library-kind
|
||||
on-change!
|
||||
(lambda (value)
|
||||
(update-library-kind!)))
|
||||
(send sel-media-server
|
||||
on-change!
|
||||
(lambda (value)
|
||||
(reset-media-server-root!)))
|
||||
(send sel-media-server-container
|
||||
on-change!
|
||||
(lambda (value)
|
||||
(open-media-server-container!)))
|
||||
(send this refresh-media-servers)
|
||||
|
||||
(send this bind! 'browse 'click (λ (el evt data)
|
||||
(send this select-library)))
|
||||
(send this bind!
|
||||
'refresh-media-servers
|
||||
'click
|
||||
(lambda (element event data)
|
||||
(send this refresh-media-servers)))
|
||||
(send this bind!
|
||||
'media-server-root-up
|
||||
'click
|
||||
(lambda (element event data)
|
||||
(media-server-root-up!)))
|
||||
|
||||
(send this bind! 'ok 'click (λ (el evt data)
|
||||
(let ((name (get inp-name))
|
||||
(library-kind
|
||||
(string->symbol
|
||||
(get sel-library-kind)))
|
||||
(local-path (get inp-local-path)))
|
||||
(case library-kind
|
||||
((filesystem)
|
||||
(result-cb
|
||||
id
|
||||
name
|
||||
library-kind
|
||||
local-path
|
||||
host
|
||||
(current-media-server-item-limit))
|
||||
(send this close))
|
||||
((media-server)
|
||||
(let ((server
|
||||
(selected-media-server)))
|
||||
(when server
|
||||
(result-cb
|
||||
id
|
||||
(if (string=? name "")
|
||||
(upnp:media-server-name
|
||||
server)
|
||||
name)
|
||||
library-kind
|
||||
media-server-root-id
|
||||
(or
|
||||
(upnp:upnp-device-udn
|
||||
server)
|
||||
(upnp:media-server-name
|
||||
server))
|
||||
(current-media-server-item-limit))
|
||||
(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]
|
||||
[renderers '()]
|
||||
[libraries-changed-callback (lambda () (void))]
|
||||
[cache-cleared-callback (lambda () (void))])
|
||||
(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 btn-clear-cache #f)
|
||||
(define lbl-language #f)
|
||||
(define lbl-name #f)
|
||||
(define lbl-kind #f)
|
||||
(define lbl-local-path #f)
|
||||
(define lbl-host #f)
|
||||
(define lbl-lib #f)
|
||||
(define lbl-renderers #f)
|
||||
(define lbl-renderer-name #f)
|
||||
(define lbl-volume-curve #f)
|
||||
(define renderer-body #f)
|
||||
(define div-language #f)
|
||||
(define sel-language #f)
|
||||
|
||||
(define libs
|
||||
(send (get-library-factory)
|
||||
get-libraries-config))
|
||||
|
||||
(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 btn-clear-cache
|
||||
set-innerHTML!
|
||||
(tr 'clear-cache))
|
||||
(send lbl-language set-innerHTML! (tr 'language))
|
||||
(send lbl-name set-innerHTML! (tr 'name))
|
||||
(send lbl-kind set-innerHTML! (tr 'library-kind))
|
||||
(send lbl-local-path set-innerHTML! (tr 'local-path))
|
||||
(send lbl-host set-innerHTML! (tr 'host))
|
||||
(send lbl-lib set-innerHTML! (tr 'lbl-libary-path))
|
||||
(send lbl-renderers set-innerHTML! (tr 'renderers))
|
||||
(send lbl-renderer-name set-innerHTML! (tr 'name))
|
||||
(send lbl-volume-curve
|
||||
set-innerHTML!
|
||||
(tr 'logarithmic-volume))
|
||||
)
|
||||
|
||||
(define/public (update-renderers)
|
||||
(let ((rows
|
||||
(for/list ((renderer (in-list renderers))
|
||||
(idx (in-naturals)))
|
||||
(list
|
||||
'tr
|
||||
(list (list 'id
|
||||
(format "renderer-~a" idx)))
|
||||
(list 'td
|
||||
'((class "name"))
|
||||
(send renderer get-name))
|
||||
(list
|
||||
'td
|
||||
'((class "volume-curve"))
|
||||
(list
|
||||
'input
|
||||
(append
|
||||
(list
|
||||
'(type "checkbox")
|
||||
'(class "renderer-volume-curve")
|
||||
(list 'id
|
||||
(format "renderer-volume-curve-~a"
|
||||
idx)))
|
||||
(if (eq? (send renderer
|
||||
get-volume-curve)
|
||||
'logarithmic)
|
||||
'((checked "checked"))
|
||||
'()))))))))
|
||||
(send renderer-body
|
||||
set-innerHTML!
|
||||
(apply string-append
|
||||
(map xexpr->string rows)))
|
||||
(send this
|
||||
bind!
|
||||
"table.renderers input.renderer-volume-curve"
|
||||
'change
|
||||
(lambda (el evt data)
|
||||
(let ((idx
|
||||
(string->number
|
||||
(substring
|
||||
(format "~a" (send el id))
|
||||
(string-length
|
||||
"renderer-volume-curve-")))))
|
||||
(send (list-ref renderers idx)
|
||||
set-volume-curve!
|
||||
(if (send el get)
|
||||
'logarithmic
|
||||
'linear)))))))
|
||||
|
||||
(define/public (update-libraries)
|
||||
(let ((count (send libs count)))
|
||||
(letrec ((f (λ (i)
|
||||
(if (= i count)
|
||||
'()
|
||||
(cons
|
||||
(let* ((id (send libs library-id i))
|
||||
(entry (begin
|
||||
(dbg-rktplayer "index = ~a, id = ~a, symbol? id = ~a" i id (symbol? id))
|
||||
(send libs get-library id)))
|
||||
(name (send entry get-name))
|
||||
(kind (send entry get-kind))
|
||||
(local-path (send entry get-root))
|
||||
(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 (list '(class "kind"))
|
||||
(tr kind))
|
||||
(list 'td '((class "path"))
|
||||
(format "~a" local-path))
|
||||
(list 'td '((class "host"))
|
||||
(or 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)))
|
||||
(libraries-changed-callback)
|
||||
)))
|
||||
))))
|
||||
|
||||
(define/public (add-library)
|
||||
(let* ((cb (λ (id name kind root host item-limit)
|
||||
(send libs add-library
|
||||
(library-item
|
||||
id
|
||||
name
|
||||
kind
|
||||
1
|
||||
root
|
||||
(if (string=? host "")
|
||||
#f
|
||||
host)
|
||||
item-limit
|
||||
#f))
|
||||
(send this update-libraries)
|
||||
(libraries-changed-callback)))
|
||||
(dlg (new library-dlg% [parent this]
|
||||
[settings (send settings clone 'library-dlg)]
|
||||
[kind 'filesystem] [result-cb cb])))
|
||||
(send dlg show)))
|
||||
|
||||
(define/public (edit-library)
|
||||
(let ((entry
|
||||
(send libs current-library)))
|
||||
(when entry
|
||||
(let* ((id (send entry get-id))
|
||||
(kind (send entry get-kind))
|
||||
(kind-version
|
||||
(send entry get-kind-version))
|
||||
(current
|
||||
(send entry is-current?))
|
||||
(cb
|
||||
(lambda (id name kind root host item-limit)
|
||||
(send libs
|
||||
update-item!
|
||||
(library-item
|
||||
id
|
||||
name
|
||||
kind
|
||||
kind-version
|
||||
root
|
||||
(if (string=? host "")
|
||||
#f
|
||||
host)
|
||||
item-limit
|
||||
current))
|
||||
(send this update-libraries)
|
||||
(libraries-changed-callback)))
|
||||
(dlg
|
||||
(new library-dlg%
|
||||
[parent this]
|
||||
[settings
|
||||
(send settings
|
||||
clone
|
||||
'library-dlg)]
|
||||
[id id]
|
||||
[name
|
||||
(send entry get-name)]
|
||||
[kind kind]
|
||||
[kind-editable? #f]
|
||||
[local-path
|
||||
(format
|
||||
"~a"
|
||||
(send entry get-root))]
|
||||
[host
|
||||
(or
|
||||
(send entry get-host)
|
||||
"")]
|
||||
[item-limit
|
||||
(send entry get-item-limit)]
|
||||
[result-cb cb])))
|
||||
(send dlg show)))))
|
||||
|
||||
(define/public (remove-library)
|
||||
(let ((entry
|
||||
(send libs current-library)))
|
||||
(when entry
|
||||
(send libs
|
||||
remove-library
|
||||
(send entry get-id))
|
||||
(let ((new-current
|
||||
(send libs current-library)))
|
||||
(when new-current
|
||||
(send new-current
|
||||
set-current!
|
||||
#t)))
|
||||
(libraries-changed-callback)
|
||||
(send this update-libraries))))
|
||||
|
||||
(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! btn-clear-cache
|
||||
(send this element 'clear-cache))
|
||||
(set! lbl-language (send this element 'lbl-language))
|
||||
(set! lbl-lib (send this element 'lbl-libary-path))
|
||||
(set! lbl-renderers
|
||||
(send this element 'lbl-renderers))
|
||||
(set! lbl-renderer-name
|
||||
(send this element 'lbl-renderer-name))
|
||||
(set! lbl-volume-curve
|
||||
(send this element 'lbl-volume-curve))
|
||||
(set! renderer-body
|
||||
(send this element 'renderer-body))
|
||||
(set! lbl-name (send this element 'lbl-name))
|
||||
(set! lbl-kind (send this element 'lbl-kind))
|
||||
(set! lbl-local-path (send this element 'lbl-local-path))
|
||||
(set! lbl-host (send this element 'lbl-host))
|
||||
(set! div-language (send this element 'language))
|
||||
|
||||
(send this set-labels)
|
||||
|
||||
(send div-language set-innerHTML! (make-select-list 'sel-lang (languages) (current-lang)))
|
||||
|
||||
(send this bind! 'sel-lang 'change (λ (el evt data)
|
||||
(let ((lang (string->symbol
|
||||
(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 (λ (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 bind!
|
||||
'clear-cache
|
||||
'click
|
||||
(lambda (el evt data)
|
||||
(cache-cleared-callback)))
|
||||
|
||||
(send this update-libraries)
|
||||
(send this update-renderers)
|
||||
)
|
||||
)
|
||||
(info-rktplayer "page loaded")
|
||||
)
|
||||
|
||||
(begin
|
||||
#t)
|
||||
)
|
||||
)
|
||||
Reference in New Issue
Block a user