multiple libraries

2026-07-29 13:27:48 +02:00
parent f949e2dbb3
commit 727e0643af
9 changed files with 573 additions and 184 deletions
@@ -0,0 +1,114 @@
+#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)
+        (set! libs (sort (map to-library (send cfg get 'libraries '()))
+                         (lambda (a b)
+                           (string<? (send a get-name) (send b get-name))))))
+      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)))
+        (for/or ([lib libs])
+          (when (eq? (send lib get-id) id)
+            lib))))
+
+    (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 (send l ->list) 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))))
+
+    ))