From b59267437221458b0f25aaf8c0ebc537f3942afd Mon Sep 17 00:00:00 2001 From: SqrtMinusOne Date: Sat, 7 Aug 2021 12:27:33 +0300 Subject: [PATCH] feat: fetching covers works --- lyrics-fetcher-genius.el | 26 +++++---- lyrics-fetcher.el | 117 +++++++++++++++++++++++++++++++++++---- 2 files changed, 123 insertions(+), 20 deletions(-) diff --git a/lyrics-fetcher-genius.el b/lyrics-fetcher-genius.el index 4c9345a..021421a 100644 --- a/lyrics-fetcher-genius.el +++ b/lyrics-fetcher-genius.el @@ -5,7 +5,7 @@ ;; Author: Korytov Pavel ;; Maintainer: Korytov Pavel ;; Version: 0.1.0 -;; Package-Requires: ((emacs "27") (request "0.3.2")) +;; Package-Requires: ((emacs "27") (request "0.3.2") (f "0.20.0")) ;; Homepage: https://github.com/SqrtMinusOne/lyrics-fetcher.el ;; This file is NOT part of GNU Emacs. @@ -33,6 +33,7 @@ (require 'json) (require 'seq) (require 'shr) +(require 'f) (defcustom lyrics-fetcher-genius-access-token nil "Genius access token. Get one at https://genius.com." @@ -143,7 +144,7 @@ first song." "Fetch lyrics from genius.com page at URL and call CALLBACK with result. If SYNC is non-nil, the request will be performed synchronously, but -the function will still make Emacs lags, as HTML parsing is pretty +the function will still make Emacs lag, as HTML parsing is pretty expensive." (message "Getting lyrics from %s" url) (request url @@ -167,7 +168,7 @@ expensive." (lambda (&key error-thrown &allow-other-keys) (message "Error!: %S" error-thrown))))) -(defun lyrics-fetcher-genius-download-cover (track callback folder) +(defun lyrics-fetcher-genius-download-cover (track callback folder &optional sync) "Downloads album cover of TRACK. Requies `lyrics-fetcher-genius-access-token' to be set. @@ -177,23 +178,28 @@ TRACK should be EMMS-compatible alist or string, take a look at successful, CALLBACK will be called with the resulting lyrics text. -The file will be saved to FOLDER and will be named -\"cover_full.\". +In EMMS, track contains all posible information about the album. -CALLBACK will be called with a path to the resulting file." +The file will be saved to FOLDER and will be named +\"cover_large.\". + +CALLBACK will be called with a path to the resulting file. + +If SYNC is non-nil, user will be prompted for a matching song." (lyrics-fetcher--genius-do-query track (lambda (data) (lyrics-fetcher--genius-save-album-picture - (lyrics-fetcher--genius-get-data-from-response data 'id) + (lyrics-fetcher--genius-get-data-from-response data 'id sync) callback - folder)))) + folder)) + sync)) (defun lyrics-fetcher--genius-save-album-picture (id callback folder) "Save an album cover of a song of given ID. The file will be saved to FOLDER and will be named -\"cover_full.\". +\"cover_large.\". CALLBACK will be called with a path to the resulting file." (request @@ -230,7 +236,7 @@ CALLBACK will be called with the path to the resulting file." (cl-function (lambda (&key data &allow-other-keys) (let ((filename - (concat folder "cover_full" (url-file-extension url)))) + (concat folder "cover_large" (url-file-extension url)))) (with-temp-file filename (toggle-enable-multibyte-characters) (set-buffer-file-coding-system 'raw-text) diff --git a/lyrics-fetcher.el b/lyrics-fetcher.el index 0343e96..6b25d95 100644 --- a/lyrics-fetcher.el +++ b/lyrics-fetcher.el @@ -5,7 +5,7 @@ ;; Author: Korytov Pavel ;; Maintainer: Korytov Pavel ;; Version: 0.1.0 -;; Package-Requires: ((emacs "27") (emms "7")) +;; Package-Requires: ((emacs "27") (emms "7") (f "0.20.0")) ;; Homepage: https://github.com/SqrtMinusOne/lyrics-fetcher.el ;; This file is NOT part of GNU Emacs. @@ -29,6 +29,7 @@ ;;; Code: (require 'lyrics-fetcher-genius) +(require 'f) (require 'emms) (defgroup lyrics-fetcher () @@ -92,7 +93,19 @@ extensibility." :type 'function :group 'lyrics-fetcher) -;;; Performing actual fetching +(defcustom lyrics-fetcher-small-cover-size + "100x100" + "Small cover size." + :type 'string + :group 'lyrics-fetcher) + +(defcustom lyrics-fetcher-medium-cover-size + "200x200" + "Medium cover size." + :type 'string + :group 'lyrics-fetcher) + +;;; Actual lyrics fetching (defun lyrics-fetcher-format-song-name (track) "Format TRACK to a human-readable form. @@ -210,8 +223,7 @@ FORCE-FETCH and SYNC are passed to `lyrics-fetcher-show-lyrics'." (unless start (setq start 0)) (message "Fetching lyrics for %s / %s songs" start (+ start (length tracks))) - (let ((current-prefix-arg current-prefix-arg) - (force-fetch (or force-fetch (member (prefix-numeric-value current-prefix-arg) '(4 16)))) + (let ((force-fetch (or force-fetch (member (prefix-numeric-value current-prefix-arg) '(4 16)))) (sync (or sync (member (prefix-numeric-value current-prefix-arg) '(16))))) (unless (seq-empty-p tracks) (lyrics-fetcher-show-lyrics @@ -226,7 +238,6 @@ FORCE-FETCH and SYNC are passed to `lyrics-fetcher-show-lyrics'." :sync sync)))))) ;;; EMMS integration - (defun lyrics-fetcher-emms-browser-fetch-at-point () "Fetch data for the current point in EMMS browser. @@ -258,6 +269,18 @@ the same way as `lyrics-fetcher-show-lyrics'." (setq songs (append songs (lyrics-fetcher--emms-extract-songs datum)))) songs))) +(defun lyrics-fetcher-emms-browser-fetch-covers-at-point () + "Fetch album covers for the current point in EMMS browser. + +Behavior of the function is modified by \\[universal-argument] +the same way as `lyrics-fetcher-show-lyrics'." + (interactive) + (let ((data (emms-browser-bdata-at-point))) + (if (not data) + (message "Nothing is found at point!") + (lyrics-fetcher--fetch-cover-many + (lyrics-fetcher--emms-extract-albums data))))) + (defun lyrics-fetcher--emms-extract-albums (bdata) "Extract a list of sample song alists from each album in BDATA. @@ -277,16 +300,15 @@ One sample song per each album." (defun lyrics-fetcher--lyrics-saved-p (filename) "Check if lyrics for FILENAME are already saved." - (file-exists-p (lyrics-fetcher--process-filename filename))) + (f-exists-p (lyrics-fetcher--process-filename filename))) (defun lyrics-fetcher--save-lyrics (text filename) "Save TEXT of lyrics in `lyrics-fetcher-lyrics-folder'. FILENAME shoud be given without extension." - (unless (file-exists-p lyrics-fetcher-lyrics-folder) - (make-directory lyrics-fetcher-lyrics-folder)) - (with-temp-file (lyrics-fetcher--process-filename filename) - (insert text))) + (unless (f-exists-p lyrics-fetcher-lyrics-folder) + (f-mkdir lyrics-fetcher-lyrics-folder)) + (f-write text 'utf-8 (lyrics-fetcher--process-filename filename))) (defun lyrics-fetcher--open-lyrics (filename &optional track) "Open lyrics for in FILENAME in `lyrics-fetcher-lyrics-folder'. @@ -328,5 +350,80 @@ TRACK is either a string or EMMS alist." \\{lyrics-fetcher-view-mode-map}") +;;; Album cover fetching + + +(cl-defun lyrics-fetcher--fetch-cover-many (tracks &optional &key start force-fetch sync) + "Fetch album covers for every track in the TRACKS list. + +This functions calls itself recursively. START is an indicator of +position in the list. + +FORCE-FETCH and SYNC are passed to `lyrics-fetcher--fetch-cover'." + (unless start + (setq start 0)) + (message "Fetching covers for %s / %s albums" start (+ start (length tracks))) + (if (seq-empty-p tracks) + (message "Done. Refresh EMMS browser to see the result.") + (let ((force-fetch (or force-fetch (member (prefix-numeric-value current-prefix-arg) '(4 16)))) + (sync (or sync (member (prefix-numeric-value current-prefix-arg) '(16))))) + (lyrics-fetcher--fetch-cover + (car tracks) + :callback + (lambda (&rest _) + (lyrics-fetcher--fetch-cover-many + (cdr tracks) + :start (+ start 1) + :force-fetch force-fetch + :sync sync)))))) + +(cl-defun lyrics-fetcher--fetch-cover (track &optional &key callback sync force-fetch) + "Fetch cover for a given TRACK. + +Call CALLBACK with the resulting filename of full cover. + +If SYNC is non-nil, prompt user for a matching track. + +If FORCE-FETCH is non-nil, always fetch regardless of whether the +file exists." + (let ((covers-found (f-entries + (f-dirname (cdr (assoc 'name track))) + (lambda (f) + (string-match-p + (rx (* nonl) "cover_large" (* nonl)) f))))) + (if (and (not force-fetch) + (not (seq-empty-p covers-found))) + (progn + (message "Cover already downloaded") + (when callback + (funcall callback (car covers-found)))) + (funcall lyrics-fetcher-download-cover-method + track + (lambda (filename) + (lyrics-fetcher--generate-cover-sizes filename) + (message "Saved cover for %s" + (cdr (assoc 'info-album track))) + (when callback + (funcall callback filename))) + (concat (f-dirname (cdr (assoc 'name track))) "/") + sync)))) + +(defun lyrics-fetcher--generate-cover-sizes (filename) + "Create small and medium versions of FILENAME. + +Requires imagemagick installed." + (shell-command-to-string + (format "convert \"%s\" -resize %s^ -gravity Center -extent %s \"%s\"" + filename + lyrics-fetcher-small-cover-size + lyrics-fetcher-small-cover-size + (f-join (f-dirname filename) (concat "cover_small." (f-ext filename))))) + (shell-command-to-string + (format "convert \"%s\" -resize %s^ -gravity Center -extent %s \"%s\"" + filename + lyrics-fetcher-medium-cover-size + lyrics-fetcher-medium-cover-size + (f-join (f-dirname filename) (concat "cover_med." (f-ext filename)))))) + (provide 'lyrics-fetcher) ;;; lyrics-fetcher.el ends here