125 lines
3.9 KiB
Racket
125 lines
3.9 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
"utils.rkt"
|
|
)
|
|
|
|
(provide libraries%
|
|
library%
|
|
)
|
|
|
|
|
|
(define library%
|
|
(class object%
|
|
(init-field [id (new-id)] [name ""] [local-path ""]
|
|
[host ""] [prefixes ""] [current #f])
|
|
(super-new)
|
|
|
|
(define/public (get-id) id)
|
|
(define/public (get-name) name)
|
|
(define/public (get-local-path) local-path)
|
|
(define/public (get-host) host)
|
|
(define/public (get-prefixes) prefixes)
|
|
(define/public (is-current?) current)
|
|
(define/public (get-current) current)
|
|
(define/public (set-current! c) (set! current c))
|
|
(define/public (->list)
|
|
(list id name local-path host prefixes current))
|
|
))
|
|
|
|
|
|
(define libraries%
|
|
(class object%
|
|
(init-field [settings settings])
|
|
(super-new)
|
|
|
|
(define libs #f)
|
|
|
|
(define cfg (send settings clone 'settings))
|
|
|
|
(define (to-library e)
|
|
(let ((f (lambda (id n lp h p . c)
|
|
(let ((cc (if (null? c) #f (car c))))
|
|
(new library% [id id]
|
|
[name n] [local-path lp]
|
|
[host h] [prefixes p] [current cc])
|
|
))))
|
|
(apply f e)
|
|
)
|
|
)
|
|
|
|
(define (from-library l)
|
|
(send l ->list))
|
|
|
|
(define/public (libraries)
|
|
(when (eq? libs #f)
|
|
(let ((cfg-libs (send cfg get 'libraries '())))
|
|
(dbg-rktplayer "libraries from ini: ~a" cfg-libs)
|
|
(set! libs (sort (map to-library cfg-libs)
|
|
(lambda (a b)
|
|
(string<? (send a get-name) (send b get-name)))))
|
|
(dbg-rktplayer "libs: ~a" (map (λ (x) (list (send x get-id) (send x get-name))) libs))
|
|
))
|
|
libs)
|
|
|
|
(define/public (set-libraries! libs*)
|
|
(send cfg set! 'libraries (map from-library libs*))
|
|
(set! libs #f))
|
|
|
|
(define/public (count)
|
|
(length (send this libraries)))
|
|
|
|
(define/public (library-id idx)
|
|
(let ((libs (send this libraries)))
|
|
(if (and (>= idx 0) (< idx (length libs)))
|
|
(send (list-ref libs idx) get-id)
|
|
#f)))
|
|
|
|
(define/public (get-library id)
|
|
(let ((libs (send this libraries)))
|
|
(letrec ((f (λ (libs)
|
|
(if (null? libs)
|
|
#f
|
|
(let* ((lib (car libs))
|
|
(lib-id (send lib get-id)))
|
|
(dbg-rktplayer "symbol? lib-id: ~a, lib-id: ~a (~a) eq? ~a" (symbol? lib-id) lib-id (send lib get-name) id)
|
|
(if (eq? lib-id id)
|
|
lib
|
|
(f (cdr libs))))))))
|
|
(f libs))))
|
|
|
|
(define/public (remove-library id)
|
|
(let ((libs (send this libraries)))
|
|
(send this set-libraries! (filter (λ (lib)
|
|
(not (eq? (send lib get-id) id)))
|
|
libs))))
|
|
|
|
(define/public (add-library l)
|
|
(let ((libs (send this libraries)))
|
|
(send this set-libraries! (cons l libs))
|
|
(set! libs #f)
|
|
(send l get-id)))
|
|
|
|
(define/public (update-library l)
|
|
(let ((libs (send this libraries))
|
|
(id (send l get-id)))
|
|
(send this set-libraries! (map (λ (lib)
|
|
(if (eq? (send lib get-id) id)
|
|
l
|
|
lib))
|
|
libs))))
|
|
|
|
(define/public (current-library)
|
|
(letrec ((f (lambda (libs)
|
|
(if (null? libs)
|
|
(if (= (send this count) 0)
|
|
#f (send this get-library
|
|
(send this library-id 0)))
|
|
(let ((l (car libs)))
|
|
(if (send l is-current?)
|
|
l
|
|
(f (cdr libs))))))
|
|
))
|
|
(f (send this libraries))))
|
|
|
|
)) |