| 1 | ;;; emms-source-beets.el --- EMMS source utilizing a beets library database -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2023 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Daniel Semyonov <daniel@dsemy.com> |
| 6 | |
| 7 | ;; This file is part of EMMS. |
| 8 | |
| 9 | ;; EMMS is free software; you can redistribute it and/or modify it |
| 10 | ;; under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; EMMS is distributed in the hope that it will be useful, but WITHOUT |
| 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
| 16 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
| 17 | ;; License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with EMMS; see the file COPYING. If not, write to the Free |
| 21 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, |
| 22 | ;; MA 02110-1301, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This file provides an EMMS source which utilizes Emacs' SQLite |
| 27 | ;; support to read a beets library database. |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | (eval-when-compile |
| 32 | (require 'subr-x) |
| 33 | |
| 34 | (declare-function sqlite-next "sqlite.c") |
| 35 | (declare-function sqlite-open "sqlite.c") |
| 36 | (declare-function sqlite-select "sqlite.c")) |
| 37 | |
| 38 | (require 'emms) |
| 39 | |
| 40 | (defgroup emms-source-beets nil |
| 41 | "EMMS source for beets library databases." |
| 42 | :group 'emms-source |
| 43 | :prefix "emms-source-beets-") |
| 44 | |
| 45 | (defcustom emms-source-beets-database |
| 46 | (expand-file-name "beets/library.db" |
| 47 | (or (getenv "XDG_CONFIG_HOME") "~/.config")) |
| 48 | "Database containing beets library information." |
| 49 | :type '(file :must-match t)) |
| 50 | |
| 51 | (defconst emms-source-beets--items-columns |
| 52 | '("title" "artist" "artist_sort" "album" "albumartist" |
| 53 | "albumartist_sort" "genre" "composer" "composer_sort" "year" "track" |
| 54 | "tracktotal" "disc" "disctotal" "label" "original_year" "length") |
| 55 | "Columns to process in the \"items\" table.") |
| 56 | |
| 57 | (defcustom emms-source-beets-sort-columns |
| 58 | '(("albumartist_sort") ("album") ("track")) |
| 59 | "List of columns to sort by when adding tracks from a beets database. |
| 60 | Each \"column\" should be cons cell whose car is the column name (a |
| 61 | string), and the cdr, if non-nil, indicates a descending sort order |
| 62 | for the column." |
| 63 | :type `( repeat |
| 64 | (cons :tag "Sort" |
| 65 | (radio :tag "Column" |
| 66 | ,@(mapcar (lambda (col) `(const ,col)) |
| 67 | emms-source-beets--items-columns)) |
| 68 | (boolean :tag "Descending")))) |
| 69 | |
| 70 | (defun emms-source-beets--ensure-sqlite () |
| 71 | "Emit a user error if SQLite support is not available." |
| 72 | (or (and (fboundp 'sqlite-available-p) |
| 73 | (sqlite-available-p)) |
| 74 | (user-error |
| 75 | "SQLite support is not available (required to read beets databases)"))) |
| 76 | |
| 77 | ;;;###autoload (autoload 'emms-play-beets "emms-source-beets" nil t) |
| 78 | ;;;###autoload (autoload 'emms-add-beets "emms-source-beets" nil t) |
| 79 | (define-emms-source beets (&optional database filter sort) |
| 80 | "An EMMS source for beets library databases. |
| 81 | |
| 82 | DATABASE should be a path to a beets library database |
| 83 | \(`emms-source-beets-database' is used by default). |
| 84 | When called interactively, prefix argument FILTER will cause added |
| 85 | tracks to be filtered according to unique values from columns in the |
| 86 | \"items\" table of the database; with a double prefix argument (or |
| 87 | more), SORT will also be set interactively, defaulting to the value of |
| 88 | `emms-source-beets-sort-columns' otherwise. |
| 89 | |
| 90 | Filtering is done in two steps: |
| 91 | - Choose column(s) (with completion). |
| 92 | - For each chosen column (in order), choose from its unique values |
| 93 | (with completion) which match any row which hasn't been filtered by |
| 94 | a previous choice. |
| 95 | |
| 96 | For example, if you have 5 albums: |
| 97 | Nice Band - Nice Album (2001) |
| 98 | Nice Band - Good Album (2002) |
| 99 | Cool Band - Cool Album (2001) |
| 100 | Cool Band - Cold Album (2002) |
| 101 | Cool Band - Warm Album (2003) |
| 102 | |
| 103 | Then: |
| 104 | |
| 105 | \\[universal-argument] \\[emms-play-beets] year \\`RET' 2001 \\`RET' |
| 106 | |
| 107 | will play \"Nice Album\" and \"Cool Album\". The year chosen must be |
| 108 | one of 2001, 2002 or 2003 (or any combination of them). |
| 109 | |
| 110 | \\[universal-argument] \\[emms-add-beets] albumartist,year \ |
| 111 | \\`RET' Nice Band \\`RET' 2002 \\`RET' |
| 112 | |
| 113 | will add only \"Good Album\". Since the first choice was \"Nice |
| 114 | Band\", the choice of year is restricted to 2001 to 2002 (or both). |
| 115 | |
| 116 | Sorting occurs after filtering, and allows selecting multiple columns |
| 117 | to sort by." |
| 118 | (interactive |
| 119 | (when-let* (((emms-source-beets--ensure-sqlite)) |
| 120 | (filter (and current-prefix-arg (cons nil ""))) |
| 121 | (sort (prog1 (or current-prefix-arg t) |
| 122 | ;; Unset after use unconditionally to prevent |
| 123 | ;; EMMS's default behavior when source |
| 124 | ;; commands are called with a prefix argument. |
| 125 | (setq current-prefix-arg nil prefix-arg nil))) |
| 126 | (db (sqlite-open emms-source-beets-database)) |
| 127 | (dec " (descending)")) |
| 128 | (dolist ( col (completing-read-multiple |
| 129 | "Filter by: " |
| 130 | emms-source-beets--items-columns nil t)) |
| 131 | ;; For each column chosen to filter by, only allow |
| 132 | ;; choosing between distinct values which correspond |
| 133 | ;; to items which matched distinct values chosen for |
| 134 | ;; previously processed columns. |
| 135 | (when-let* ((where (cdr filter)) |
| 136 | (dist (sqlite-select |
| 137 | db (format "select distinct %s from items%s" |
| 138 | col (if (string-empty-p where) |
| 139 | "" (concat " where" where))) |
| 140 | (car filter))) |
| 141 | (dist (if (stringp (caar dist)) dist |
| 142 | (mapcar (lambda (val) (number-to-string (car val))) |
| 143 | dist)))) |
| 144 | (setcdr filter (format " %s in (%s)%s" col |
| 145 | (mapconcat |
| 146 | (lambda (_) "?") |
| 147 | (mapcar (lambda (val) (push val (car filter))) |
| 148 | (completing-read-multiple |
| 149 | (concat col ": ") dist nil t)) |
| 150 | ", ") |
| 151 | (if (string-empty-p where) "" |
| 152 | (concat " and " where)))))) |
| 153 | (list db filter |
| 154 | (and (> (prefix-numeric-value sort) 4) ; more than one C-u |
| 155 | (mapcan |
| 156 | (lambda (c) |
| 157 | (list (if (string-suffix-p dec c) |
| 158 | (cons (string-remove-suffix dec c) t) |
| 159 | (list c)))) |
| 160 | (completing-read-multiple |
| 161 | "Sort added tracks by: " |
| 162 | `(,@emms-source-beets--items-columns |
| 163 | ,@(mapcar (lambda (c) (concat c dec)) |
| 164 | emms-source-beets--items-columns)) |
| 165 | nil t)))))) |
| 166 | (when-let* (((emms-source-beets--ensure-sqlite)) |
| 167 | (db (or database (sqlite-open emms-source-beets-database))) |
| 168 | (filter (or filter (cons nil ""))) |
| 169 | (where (cdr filter)) |
| 170 | (sort (or sort emms-source-beets-sort-columns)) |
| 171 | (db (sqlite-select |
| 172 | db (format "select path, %s from items%s order by %s" |
| 173 | (mapconcat #'identity |
| 174 | emms-source-beets--items-columns |
| 175 | ", ") |
| 176 | (if (string-empty-p where) "" |
| 177 | (concat " where" where)) |
| 178 | (mapconcat |
| 179 | (lambda (col) |
| 180 | (if (cdr col) (concat (car col) " desc") |
| 181 | (car col))) |
| 182 | sort ", ")) |
| 183 | (car filter) 'set)) |
| 184 | (init (gensym))) |
| 185 | (set init (remq 'emms-info-initialize-track |
| 186 | emms-track-initialize-functions)) |
| 187 | (let (item track path) |
| 188 | (while (and (setq item (sqlite-next db)) |
| 189 | (setq track (emms-dictionary '*track))) |
| 190 | (when (setq path (decode-coding-string (car item) 'utf-8 t)) |
| 191 | (emms-dictionary-set track 'type 'file) |
| 192 | (emms-dictionary-set track 'name path) |
| 193 | (mapc (lambda (type) |
| 194 | (when-let* ((val (car (setq item (cdr item))))) |
| 195 | (setq type (cond ((string-match "_" type) |
| 196 | (replace-match "" nil nil type)) |
| 197 | ((member type '("track" "disc")) |
| 198 | (concat type "number")) |
| 199 | (t type))) |
| 200 | (if (and (string= type "length") (numberp val)) |
| 201 | (progn (setq val (ceiling val)) |
| 202 | (emms-dictionary-set |
| 203 | track 'info-playing-time-min (/ val 60)) |
| 204 | (emms-dictionary-set |
| 205 | track 'info-playing-time-sec (% val 60)) |
| 206 | (emms-dictionary-set |
| 207 | track 'info-playing-time val)) |
| 208 | (when (numberp val) (setq val (number-to-string val))) |
| 209 | (unless (string-blank-p val) |
| 210 | (emms-dictionary-set |
| 211 | track (intern (concat "info-" type)) val))))) |
| 212 | emms-source-beets--items-columns) |
| 213 | (run-hook-with-args init track) |
| 214 | (emms-playlist-insert-track track) |
| 215 | (when (fboundp emms-cache-modified-function) |
| 216 | (funcall emms-cache-modified-function track)) |
| 217 | (when (fboundp emms-cache-set-function) |
| 218 | (funcall emms-cache-set-function 'file path track))))))) |
| 219 | |
| 220 | (provide 'emms-source-beets) |
| 221 | |
| 222 | ;;; emms-source-beets.el ends here |