From f0586d83687271525f8d6f0874dbb924ecb7f7c2 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 27 Oct 2022 15:10:28 -0500 Subject: Add: explore page; editor privilege views --- playlist.lisp | 126 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 67 insertions(+), 59 deletions(-) (limited to 'playlist.lisp') diff --git a/playlist.lisp b/playlist.lisp index 8b4b4e6..938972c 100644 --- a/playlist.lisp +++ b/playlist.lisp @@ -218,11 +218,11 @@ (princ " - " out)) (princ title out)))) -(defun create-track-list-item (list track ctl) +(defun create-track-list-item (list track ctl &optional editp) (with-clog-create list (list-item (:bind container) - (div () - (button (:content "delete " :hidden t :bind delbtn)) + (div (:bind edit-controls) + (button (:content "delete " :bind delbtn)) (button (:content "↓" :bind downbtn)) (button (:content "↑" :bind upbtn))) (div (:bind item) @@ -238,20 +238,26 @@ :track track))) (setf (tracks ctl) (insert-nth track-ctl -1 (tracks ctl) t)) - (setf (visiblep delbtn) t) - (set-on-click delbtn (thunk* (remove-track track-ctl))) - (set-on-click downbtn (thunk* (move-track-down track-ctl))) - (set-on-click upbtn (thunk* (move-track-up track-ctl)))) + + (cond + (editp + (set-on-click delbtn (thunk* (remove-track track-ctl))) + (set-on-click downbtn (thunk* (move-track-down track-ctl))) + (set-on-click upbtn (thunk* (move-track-up track-ctl)))) + (t + (setf (display edit-controls) "none")))) + (set-on-time-update audio 'update-now-playing-time) (set-on-ended audio 'advance-now-playing) (set-on-click item (thunk* (play-this-audio audio))))) (defun create-track-listing (parent pl) (when-let (ctl (cur-playlist-ctl parent)) - (let ((ol (create-ordered-list parent))) + (let ((ol (create-ordered-list parent)) + (editp (can-edit-p (session-user parent) pl))) (setf (pl-tracks ctl) ol) (dolist (track (playlist-tracks pl)) - (create-track-list-item ol track ctl))))) + (create-track-list-item ol track ctl editp))))) (defun append-track-list-item (obj track) (when-let (ctl (cur-playlist-ctl obj)) @@ -260,39 +266,40 @@ (secs-to-hms (playlist-duration (playlist 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 (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ")) - (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ") - (set-on-click - button - (thunk* - (let* ((url - (value url-input)) - (notice - (create-p notice-area :content (format nil "... Fetching ~a" url))) - (on-ok - (lambda (track) - (destroy notice) - (append-track pl track) - (append-track-list-item parent track)))) - (setf (value url-input) "") - (if-let (track (track-with-source url)) - (funcall on-ok track) - (add-fetch-track-job - url on-ok - (lambda (err) - (destroy notice) - (format t "~a" err) - (alert (window (connection-body parent)) - (format nil "Error while fetching track at: ~a~%" - url)))))))))) + (when (can-edit-p (session-user 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 (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ")) + (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ") + (set-on-click + button + (thunk* + (let* ((url + (value url-input)) + (notice + (create-p notice-area :content (format nil "... Fetching ~a" url))) + (on-ok + (lambda (track) + (destroy notice) + (append-track pl track) + (append-track-list-item parent track)))) + (setf (value url-input) "") + (if-let (track (track-with-source url)) + (funcall on-ok track) + (add-fetch-track-job + url on-ok + (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))))))) @@ -320,23 +327,24 @@ (pl-dur ctl) dur-elem (display input) "none" (display title-elem) "inline") - - (set-on-blur - input - (thunk* - (when (plusp (length (value input))) - (update-playlist-title pl (value input)) - (setf (text title-elem) (value input))) - (setf (display input) "none" - (display title-elem) "inline"))) - - (set-on-click - title-elem - (thunk* - (setf (value input) (text title-elem) - (display title-elem) "none" - (display input) "inline") - (focus input))) + + (when (can-edit-p (session-user body) pl) + (set-on-blur + input + (thunk* + (when (plusp (length (value input))) + (update-playlist-title pl (value input)) + (setf (text title-elem) (value input))) + (setf (display input) "none" + (display title-elem) "inline"))) + + (set-on-click + title-elem + (thunk* + (setf (value input) (text title-elem) + (display title-elem) "none" + (display input) "inline") + (focus input)))) (initialize-now-playing body))))) -- cgit v1.2.3