Add: track-list to playlist/ctl

1 files changed, 15 insertions, 5 deletions

diff --git a/vampire.lisp b/vampire.lisp
index 60b8a49..57e474f 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -149,7 +149,7 @@
 ;;; PLAYLIST CONTROL
 
 (defclass/std playlist/ctl ()
-  ((playlist track-display audio->track now-playing :std nil)))
+  ((playlist track-list track-display audio->track now-playing :std nil)))
 
 (defmethod (setf now-playing) :before (newval ctl)
   (with-slots (now-playing) ctl
@@ -221,6 +221,10 @@
   (setf (connection-data-item obj "playlist/ctl")
         (make-instance 'playlist/ctl :playlist playlist)))
 
+(defun install-track-list (list)
+  (let ((ctl (playlist/ctl list)))
+    (setf (track-list ctl) list)))
+
 (defun install-track-display (thumb title artist time dur play/pause)
   (let ((ctl (playlist/ctl thumb)))
     (setf (track-display ctl)
@@ -280,8 +284,6 @@
     (setf (text (time-elem (track-display ctl)))
           (secs-to-hms (media-position audio)))))
 
-;;; 
-
 (defun create-track-list-item (parent track)
   (with-clog-create parent
       (div (:bind view)
@@ -305,11 +307,18 @@
 (defun create-track-listing (parent playlist &rest args)
   (declare (ignorable args))
   (let ((list (create-ordered-list parent))) 
+    (install-track-list list)
     (dolist (track (playlist-tracks playlist))
       (with-clog-create list
           (list-item () 
                      (track-list-item (track)))))))
 
+(defun add-track-to-listing (elem track)
+  (with-slots (track-list) (playlist/ctl elem)
+    (with-clog-create track-list
+        (list-item ()
+                   (track-list-item (track))))))
+
 (defun create-track-form (parent playlist &rest args)
   (declare (ignorable args))
   (with-clog-create parent
@@ -332,13 +341,14 @@
            (add-fetch-track-job
             url
             (lambda (track)
+              (remove-from-dom notice)
               (append-track playlist track)
-              (reload (location (connection-body parent))))
+              (add-track-to-listing parent track))
             (lambda (err)
               (remove-from-dom notice)
               (format t "Error: ~a~%" err)
               (alert (window (connection-body parent))
-                     (format nil "Error whiel fetching track at: ~a~%"
+                     (format nil "Error while fetching track at: ~a~%"
                              url)))))))))
 
 (defun playlist-key-from-url (url)