diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emms-browser.el | 121 |
1 files changed, 118 insertions, 3 deletions
diff --git a/lisp/emms-browser.el b/lisp/emms-browser.el index 6b6ce28..0c348a9 100644 --- a/lisp/emms-browser.el +++ b/lisp/emms-browser.el @@ -1600,7 +1600,7 @@ included." (defun emms-browser--build-cover-filename () "Build `emms-browser--covers-filename'. -Based on from `emms-browser-covers' and +Based on from `emms-browser-covers' (when a list) and `emms-browser-covers-file-extensions'." (setq emms-browser--covers-filename (mapcar (lambda (cover) @@ -1619,8 +1619,6 @@ Based on from `emms-browser-covers' and (defun emms-browser-get-cover-from-path (path &optional size) "Return a cover filename, if it exists." - (unless emms-browser--covers-filename - (emms-browser--build-cover-filename)) (unless size (setq size 'medium)) (let* ((size-idx (cond @@ -1633,6 +1631,8 @@ Based on from `emms-browser-covers' and (funcall emms-browser-covers (file-name-directory path) size)) ((and (listp emms-browser-covers) (nth size-idx emms-browser-covers)) + (unless emms-browser--covers-filename + (emms-browser--build-cover-filename)) (car (delq nil (mapcar (lambda (cover) (let ((coverpath @@ -1997,5 +1997,120 @@ If the track is not of TYPE, return t." (emms-track-get track 'last-played nil)) (time-less-p min-date last-played)))))) +;; TODO: Add function to clear the cache from thumbnails that have no associated +;; cover folders. This is especially useful in case the music library path +;; changes: currently, all covers will have to be re-cached while the old ones +;; are left as is, useless. + +;; TODO: `emms-browser-expand-all' is slow because of all the covers (about 30 +;; sec fot 1500 covers in my case). Try to profile & optimize. It will +;; probably not be enough and we might need to run emms-browser-expand-all +;; asynchronously. + + +(defvar emms-browser-thumbnail-directory (expand-file-name "thumbnails" emms-directory) + "Directory where to store cover thumbnails.") + +(defvar emms-browser-thumbnail-small-size 128 + "Cover thumbnail will be resized if necessary so that neither width nor height exceed this dimension.") +(defvar emms-browser-thumbnail-medium-size 256 + "Cover thumbnail will be resized if necessary so that neither width nor height exceed this dimension.") +(defvar emms-browser-thumbnail-large-size 1024 ; Emms does not use large covers as of 2017-11-26. + "Cover thumbnail will be resized if necessary so that neither width nor height exceed this dimension.") + +(defun emms-browser-thumbnail-filter-default (dir) + "Select covers containing 'front' or 'cover' in DIR. +If none was found, fallback on `emms-browser-thumbnail-filter-all'. + +See `emms-browser-thumbnail-filter'." + (when (file-directory-p dir) + (let ((ls (directory-files dir t nil t)) + (case-fold-search t) + covers) + (dolist (ext emms-browser-covers-file-extensions) + (setq covers (append (seq-filter (lambda (c) (string-match (concat "\\(front\\|cover\\).*\\." ext) c)) ls) covers))) + (unless covers + (setq covers (emms-browser-thumbnail-filter-all dir))) + covers))) + +(defun emms-browser-thumbnail-filter-all (dir) + "Return the list of all files with `emms-browser-covers-file-extensions' in DIR. + +See `emms-browser-thumbnail-filter'." + (let (covers) + (dolist (ext emms-browser-covers-file-extensions) + (setq covers (append (file-expand-wildcards (expand-file-name (concat "*." ext) dir)) covers))))) + +(defvar emms-browser-thumbnail-filter 'emms-browser-thumbnail-filter-default + "This filter must hold a function that takes a directory argument and returns a list of cover file names. +The list will be processed by `emms-browser-cache-thumbnail'. +See also `emms-browser-thumbnail-filter-default'.") + +(defvar emms-browser-thumbnail-convert-program (executable-find "convert") + "The ImageMagick's `convert' program.") + +(defun emms-browser-cache-thumbnail (dir size) + "Return cached cover SIZE for album in DIR. + +SIZE must be 'small, 'medium or 'large. It will determine the +resolution of the cached file. See the variables +`emms-browser-thumbnail-SIZE-size'. + +If cover is not cached or if cache is out-of-date, re-cache it. +If both the width and the height of the cover are smaller than +`emms-browser-thumbnail-SIZE-size', it need not be cached and +will be used directly. + +Emms assumes that you have one album per folder. This function +will always use the same cover per folder. + +`emms-browser-covers' can be `fset' to this function." + (if (eq size 'large) + ;; 'large is unused for now. Return empty. + nil + (let (covers + cover + (cover-width 0) (cover-height 0) + (size-value (symbol-value (intern (concat "emms-browser-thumbnail-" (symbol-name size) "-size")))) + cache-dest-file) + (setq covers (funcall emms-browser-thumbnail-filter dir)) + (if (not covers) + nil + ;; Find best quality cover. + (let (res) + (dolist (c covers) + (setq res (image-size (create-image c) t)) + ;; image-size does not error, it returns (30 . 30) instead. + (and (> (car res) 30) (> (cdr res) 30) + (< cover-width (car res)) (< cover-height (cdr res)) + (setq cover-width (car res) cover-height (cdr res) cover c)))) + (if (and (>= size-value cover-width) (>= size-value cover-height)) + ;; No need to resize and cache. + cover + (let ((cache-dest (concat emms-browser-thumbnail-directory (file-name-directory cover)))) + (mkdir cache-dest t) + (setq cache-dest-file (concat + (expand-file-name "cover_" cache-dest) + (symbol-name size) + "." (file-name-extension cover)))) + (and emms-browser-thumbnail-convert-program + (or (not (file-exists-p cache-dest-file)) + (time-less-p (nth 5 (file-attributes cache-dest-file)) + (nth 5 (file-attributes cover)) )) + (let (err msg) + ;; An Elisp function would be faster, but Emacs does not seem be be + ;; able to resize image files. It can resize image displays though. + ;; TODO: Add image resizing support to Emacs. + (setq msg (with-output-to-string + (with-current-buffer standard-output + (setq err (call-process (executable-find "convert") nil '(t t) nil + "-resize" (format "%sx%s" size-value size-value) + cover + cache-dest-file))))) + (when (/= err 0) + (warn "%s" msg) + (setq cache-dest-file nil)))) + cache-dest-file))))) + (provide 'emms-browser) ;;; emms-browser.el ends here |