aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorPierre Neidhardt <ambrevar@gmail.com>2017-12-03 20:01:28 +0100
committerPierre Neidhardt <ambrevar@gmail.com>2017-12-09 16:34:57 +0100
commitd8a9539576903c8f06eb87a048b4d9ba7b6a6061 (patch)
tree34b3510a19e7a17bb84620503167c6d35db0e83c /lisp
parent0960515e644015c6d85549fa3bef3d67c0ee7116 (diff)
Add support for dynamic thumbnail caching
Diffstat (limited to 'lisp')
-rw-r--r--lisp/emms-browser.el121
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