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