aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--definition-macros.lisp2
-rw-r--r--playlist.lisp51
-rw-r--r--vampire.lisp38
3 files changed, 42 insertions, 49 deletions
diff --git a/definition-macros.lisp b/definition-macros.lisp
index 6ecda6d..0439e76 100644
--- a/definition-macros.lisp
+++ b/definition-macros.lisp
@@ -12,7 +12,7 @@
(if include-store-object-p
`(store-object ,@supers)
supers)))
- `(eval-when (:compile-toplevel)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
(defclass/std ,name ,supers
,slotdefs
(:metaclass persistent-class)
diff --git a/playlist.lisp b/playlist.lisp
index 303dbec..503c69a 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -239,12 +239,13 @@
(span (:content (secs-to-hms (or (track-duration track) 0)))))
(audio (:source (media-url-path track) :controls nil :bind audio)))
(setf (tracks ctl)
- (insert-nth (make-instance 'track-ctl
- :container container
- :audio audio
- :track track)
- -1
- (tracks ctl)))
+ (insert-nth
+ (make-instance 'track-ctl
+ :container container
+ :audio audio
+ :track track)
+ -1
+ (tracks ctl)))
(set-on-time-update audio 'update-now-playing-time)
(set-on-ended audio 'advance-now-playing)
(set-on-click container (alambda (play-this-audio audio)))))
@@ -255,9 +256,40 @@
(dolist (track (playlist-tracks pl))
(create-track-list-item ol track ctl))))
-(defun create-new-track-form (parent pl ctl)
- )
+(defun append-track-list-item (obj track)
+ (when-let (ctl (get-playlist-ctl obj))
+ (create-track-list-item (pl-tracks ctl) track ctl)))
+(defun create-new-track-form (parent pl)
+ (with-clog-create parent
+ (div ()
+ (section (:h3 :content "Add A Track"))
+ (label (:content "Paste a URL: " :bind url-label))
+ (form-element (:text :bind url-input))
+ (button (:content "Fetch Track" :bind button))
+ (div (:bind notice-area)))
+ (label-for url-label url-input)
+ (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ")
+ (set-on-click
+ button
+ (alambda
+ (let* ((url
+ (value url-input))
+ (notice
+ (create-p notice-area :content (format nil "... Fetching ~a" url))))
+ (setf (value url-input) "")
+ (add-fetch-track-job
+ url
+ (lambda (track)
+ (destroy notice)
+ (append-track pl track)
+ (append-track-list-item parent track))
+ (lambda (err)
+ (destroy notice)
+ (format t "~a" err)
+ (alert (window (connection-body parent))
+ (format nil "Error while fetching track at: ~a~%"
+ url)))))))))
(defun playlist-key-from-url (url)
(first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
@@ -274,7 +306,6 @@
(section (:h2 :content (playlist-title-content pl) :bind title-elem))
(now-playing-display (ctl))
(track-listing (pl ctl :bind tracks-elem))
- ;(new-track-form (pl ctl))
- )
+ (new-track-form (pl)))
(setf (pl-title ctl) title-elem
(pl-tracks ctl) tracks-elem)))))
diff --git a/vampire.lisp b/vampire.lisp
index eef75cc..cf6accc 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -79,44 +79,6 @@
url)))))))
-
-
-
-
-;; (defun create-track-form (parent playlist &rest args)
-;; (declare (ignorable args))
-;; (with-clog-create parent
-;; (div ()
-;; (section (:h3 :content "Add Track"))
-;; (label (:content "Paste URL: " :bind url-label))
-;; (form-element (:text :bind url-input))
-;; (button (:content "Fetch Track" :bind submit-button))
-;; (div (:bind notice-area)))
-;; (label-for url-label url-input)
-;; (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ")
-;; (set-on-click
-;; submit-button
-;; (alambda
-;; (let* ((url
-;; (value url-input))
-;; (notice
-;; (create-p notice-area :content (format nil "... Fetching ~a" url))))
-;; (setf (value url-input) "")
-;; (add-fetch-track-job
-;; url
-;; (lambda (track)
-;; (remove-from-dom notice)
-;; (append-track playlist track)
-;; (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 while fetching track at: ~a~%"
-;; url)))))))))
-
-
-
(defun user-page (body)
(if-let (user (session-user body))
(with-clog-create body