From b500349671a80de641a18b9a28125071e7dfa6e7 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 26 Oct 2022 14:14:30 -0500 Subject: Fix+Add: eval-when of defclass/bknr; track upload form; --- definition-macros.lisp | 2 +- playlist.lisp | 51 ++++++++++++++++++++++++++++++++++++++++---------- vampire.lisp | 38 ------------------------------------- 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 -- cgit v1.2.3