branch: externals/emms
commit 592d76cb0e0a95ffe27f88b7e455626630e1e8b3
Author: Yoni Rabkin <y...@gnu.org>
Commit: Yoni Rabkin <y...@gnu.org>
Add emms-idapi, a framework for searching online music databases.
At this point with a limited browser for search results and support
for the MusicBrainz service.
---
emms-idapi-browser.el | 214 +++++++++++++++++++++++++++++++++++++++++++
emms-idapi-musicbrainz.el | 229 ++++++++++++++++++++++++++++++++++++++++++++++
emms-idapi.el | 55 +++++++++++
emms-setup.el | 4 +-
4 files changed, 501 insertions(+), 1 deletion(-)
diff --git a/emms-idapi-browser.el b/emms-idapi-browser.el
new file mode 100644
index 0000000000..84b6386893
--- /dev/null
+++ b/emms-idapi-browser.el
@@ -0,0 +1,214 @@
+;;; emms-idapi-browser.el --- EMMS Music ID API support -*- lexical-binding:
t; -*-
+;;
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Yoni Rabkin <y...@gnu.org>
+
+;; 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:
+;;
+
+(defvar emms-idapi-browser-name
+ "Emms Search Browser"
+ "Name of the search browser buffer")
+
+(defvar emms-idapi-browser-buffer
+ nil
+ "Search browser buffer")
+
+(defvar emms-idapi-browser-mode-hook nil
+ "Emms search browser mode hook.")
+
+(defvar emms-idapi-browser-field-alist
+ '(("artist" . info-artist)
+ ("album" . info-album)
+ ("track" . info-title))
+ "Association list of readable fields and track properties.")
+
+;;; Code:
+(require 'emms-idapi)
+
+
+;;; ------------------------------------------------------------------
+;;; Search Mode
+;;; ------------------------------------------------------------------
+(defun emms-idapi-browser-get-buffer ()
+ "Get/create and return `emms-idapi-browser-mode' buffer."
+ (when (or (not emms-idapi-browser-buffer)
+ (not (buffer-live-p emms-idapi-browser-buffer)))
+ (with-current-buffer (get-buffer-create emms-idapi-browser-name)
+ (when (not (equal major-mode 'emms-idapi-browser-mode))
+ (emms-idapi-browser-mode))))
+ emms-idapi-browser-buffer)
+
+(defvar emms-idapi-browser-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "q") #'bury-buffer)
+ map)
+ "Keymap for `emms-idapi-browser-mode'.")
+
+(defun emms-idapi-browser-mode ()
+ "A major mode for the Emms search browser.
+\\{emms-idapi-browser-mode-map}"
+ (interactive)
+
+ (use-local-map emms-idapi-browser-mode-map)
+
+ (setq major-mode 'emms-idapi-browser-mode
+ mode-name "Emms-Search-Browser"
+ buffer-read-only t
+ emms-idapi-browser-buffer (current-buffer))
+
+ (run-hooks 'emms-idapi-browser-mode-hook))
+
+
+;;; ------------------------------------------------------------------
+;;; Call
+;;; ------------------------------------------------------------------
+(defun emms-idapi-browser-track-at ()
+ "Return a copy of the track at point."
+ (let* ((originial-track (emms-playlist-track-at (point)))
+ (track (copy-sequence originial-track)))
+ (when (not (emms-track-p track))
+ (error "could not read Emms track at point"))
+ track))
+
+(defun emms-idapi-browser-search-artist (track)
+ "Search for the artist of TRACK."
+ (let ((artist (or (alist-get 'info-artist track)
+ (alist-get 'info-albumartist track))))
+ (list
+ (cons 'info-artist (read-string "search for artist: " artist)))))
+
+(defun emms-idapi-browser-search-album (track)
+ "Search for the album of TRACK."
+ (let ((album (alist-get 'info-album track)))
+ (list
+ (cons 'info-album (read-string "search for album: " album)))))
+
+(defun emms-idapi-browser-search-album-artist (track)
+ "Search for both artist and album of TRACK."
+ (let ((artist (or (alist-get 'info-artist track)
+ (alist-get 'info-albumartist track)))
+ (album (alist-get 'info-album track))
+ search-album)
+ (setq search-album (read-string "search for album: " album))
+ (list
+ (cons 'info-album search-album)
+ (cons 'info-artist (read-string
+ (format "search for album \"%s\" by artist: "
search-album)
+ artist)))))
+
+(defun emms-idapi-browser-search-artist-at ()
+ "Search for the artist of the track at point."
+ (interactive)
+ (emms-idapi-browser-show
+ (emms-idapi-search emms-idapi-service
+ (emms-idapi-browser-search-artist
+ (emms-playlist-track-at (point))))))
+
+(defun emms-idapi-browser-search-album-at ()
+ "Search for the album of the track at point."
+ (interactive)
+ (emms-idapi-browser-show
+ (emms-idapi-search emms-idapi-service
+ (emms-idapi-browser-search-album
+ (emms-playlist-track-at (point))))))
+
+(defun emms-idapi-browser-search-album-artist-at ()
+ "Search for the album and artist of the track at point."
+ (interactive)
+ (emms-idapi-browser-show
+ (emms-idapi-search emms-idapi-service
+ (emms-idapi-browser-search-album-artist
+ (emms-playlist-track-at (point))))))
+
+;;; ------------------------------------------------------------------
+;;; Response
+;;; ------------------------------------------------------------------
+(defun emms-idapi-browser-print-header (header)
+ "Print the material for the search HEADER."
+ (let ((artist (alist-get 'info-artist header))
+ (album (alist-get 'info-album header))
+ (service (alist-get emms-idapi-service emms-idapi-services-alist)))
+ (when (not (or artist album))
+ (error "could not read header: %s" header))
+ (insert (format "service: %s (%s)\n"
+ (alist-get 'name service)
+ (alist-get 'website service)))
+ (when artist
+ (insert (format "artist: %s\n" artist)))
+ (when album
+ (insert (format "album: %s\n" album)))
+ (insert "\n")))
+
+(defun emms-idapi-browser-entry-packaging (entry)
+ "Print packaging information for ENTRY."
+ (let ((packaging (alist-get 'info-packaging entry)))
+ (if (and packaging
+ (not (string= "None" packaging)))
+ (format ", %s" packaging)
+ "")))
+
+(defun emms-idapi-browser-print-entry (entry)
+ "Print ENTRY."
+ (cond ((equal 'info-release (alist-get 'type entry))
+ (insert (format "\"%s\" by %s%s\n"
+ (alist-get 'info-album entry)
+ (alist-get 'info-artist entry)
+ (if (alist-get 'info-date entry)
+ (format ", released on %s" (alist-get 'info-date
entry))
+ "")))
+ (insert (format "%s tracks%s%s\n\n"
+ (alist-get 'info-track-count entry)
+ (emms-idapi-browser-entry-packaging entry)
+ (if (alist-get 'info-country entry)
+ (format ", (%s)" (alist-get 'info-country entry))
+ ""))))
+ ((equal 'info-track-artist (alist-get 'type entry))
+ (insert (format "%s%s%s\n\n"
+ (alist-get 'info-artist entry)
+ (if (alist-get 'info-country entry)
+ (format " (%s) " (alist-get 'info-country entry))
+ "")
+ (let ((begin (alist-get 'begin (alist-get 'info-time
entry)))
+ (end (alist-get 'end (alist-get 'info-time
entry))))
+ (format "%s%s"
+ (if begin begin "")
+ (if end (format " - %s, " end) ""))))))
+ (t (insert (format "%s\n" entry)))))
+
+(defun emms-idapi-browser-show (response)
+ "Display RESPONSE in a search buffer."
+ (let ((buffer (emms-idapi-browser-get-buffer)))
+ (pop-to-buffer buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "Emms Music Search Query\n\n")
+ (emms-idapi-browser-print-header (car response))
+ (insert (format "%d results\n\n" (length (cdr response))))
+ (dolist (e (cdr response))
+ (emms-idapi-browser-print-entry e)))))
+
+
+(provide 'emms-idapi-browser)
+
+;;; emms-idapi-browser.el ends here
diff --git a/emms-idapi-musicbrainz.el b/emms-idapi-musicbrainz.el
new file mode 100644
index 0000000000..4a5554979b
--- /dev/null
+++ b/emms-idapi-musicbrainz.el
@@ -0,0 +1,229 @@
+;;; emms-idapi-musicbrainz.el --- EMMS MusicBrainz API support -*-
lexical-binding: t; truncate-lines: t; -*-
+;;
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Yoni Rabkin <y...@gnu.org>
+
+;; 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:
+;;
+
+;;; Code:
+(require 'mm-bodies)
+(require 'url-vars)
+(require 'json)
+(require 'emms)
+
+
+(defvar emms-idapi-musicbrainz-url-timeout-seconds 7
+ "Number of seconds to wait before an API call times out.")
+
+(defvar emms-idapi-musicbrainz-url-buffer nil
+ "Buffer to store `url' response.")
+
+(defvar emms-idapi-musicbrainz-response-limit 30
+ "Maximum number of responses to ask for. Maximum is 100.")
+
+(defconst emms-idapi-musicbrainz-root-url "https://musicbrainz.org/ws/2/";
+ "The API root URL for the MusicBrainz service.")
+
+(defvar emms-idapi-query-local nil
+ "Cross-call storage for search query.")
+(make-variable-buffer-local 'emms-idapi-query-local)
+
+(defconst emms-idapi-musicbrainz-search-string-map
+ '((info-artist . "artist")
+ (info-albumartist . "artist")
+ (info-title . "recording")
+ (info-album . "release"))
+ "Mapping between MusicBrainz API TYPES and Emms fields.")
+
+
+;;; ------------------------------------------------------------------
+;;; Response
+;;; ------------------------------------------------------------------
+(defun emms-idapi-musicbrainz-decode (response)
+ "Decode the strings in response."
+ (mapc
+ (lambda (elt)
+ (when (stringp (cdr elt))
+ (setf (cdr elt) (mm-decode-string (cdr elt) 'utf-8))))
+ response))
+
+(defun emms-idapi-musicbrainz-read-artist (artist)
+ "Return a track from the MusicBrainz ARTIST."
+ (when (not (alist-get 'id artist))
+ (error "could not parse from: %s" artist))
+ `(*track* (search-backend . musicbrainz)
+ (type . info-track-artist)
+ (name . nil)
+ (info-arid . ,(alist-get 'id artist))
+ (info-artist . ,(alist-get 'name artist))
+ (info-type . ,(alist-get 'type artist))
+ (info-country . ,(alist-get 'country artist))
+ (info-time . ,(alist-get 'life-span artist))))
+
+(defun emms-idapi-musicbrainz-read-release (release)
+ "Return a track from the MusicBrainz RELEASE."
+ (when (not (alist-get 'id release))
+ (error "could not parse from: %s" release))
+ `(*track* (search-backend . musicbrainz)
+ (type . info-release)
+ (name . nil)
+ (info-release-id . ,(alist-get 'id release))
+ (info-artist . ,(alist-get 'name (elt (alist-get
'artist-credit release) 0)))
+ (info-album . ,(alist-get 'title release))
+ (info-status . ,(alist-get 'status release))
+ (info-disambiguation . ,(alist-get 'disambiguation release))
+ (info-packaging . ,(alist-get 'packaging release))
+ (info-date . ,(alist-get 'date release))
+ (info-country . ,(alist-get 'country release))
+ (info-track-count . ,(alist-get 'track-count release))))
+
+(defun emms-idapi-musicbrainz-read-recording (recording)
+ "Return a track from the MusicBrainz RECORDING."
+ (when (not (alist-get 'id recording))
+ (error "could not parse from: %s" recording))
+ (let ((length-ms (alist-get 'length recording)))
+ `(*track* (search-backend . musicbrainz)
+ (type . info-recording)
+ (name . ,(alist-get 'title recording))
+ (info-playing-time . ,(floor (/ length-ms 1000)))
+ (info-playing-time-min . ,(floor (/ (/ length-ms 1000) 60)))
+ (info-playing-time-sec . ,(% (floor (/ length-ms 1000)) 60))
+ (info-recording-id . ,(alist-get 'id recording))
+ (info-album . ,(alist-get 'title recording))
+ (info-length-ms . ,length-ms))))
+
+(defun emms-idapi-musicbrainz-process-type-dispatch (response)
+ "Call the appropriate processing function for RESPONSE."
+ (let ((process-f (cond ((alist-get 'artists response)
#'emms-idapi-musicbrainz-read-artist)
+ ((alist-get 'releases response)
#'emms-idapi-musicbrainz-read-release)
+ ((alist-get 'recordings response)
#'emms-idapi-musicbrainz-read-recording)
+ (t (error "unhandled response type %s" response))))
+ ;; the actual items without header data
+ (elements (cdr (nth 3 response))))
+ (append (alist-get 'query response)
+ (mapcar
+ #'(lambda (e)
+ (emms-idapi-musicbrainz-decode
+ (cdr (funcall process-f e))))
+ elements))))
+
+(defun emms-idapi-musicbrainz-process-json (buffer)
+ "Return the sexp form of the json in BUFFER."
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (let ((header-max (if (not (re-search-forward "\n\n" (point-max)))
+ (error "cannot find header")
+ (point))))
+ (append
+ (json-read-from-string
+ (mm-decode-string
+ (buffer-substring header-max (point-max))
+ 'utf-8))
+ `((query . ,(list emms-idapi-query-local)))))))
+
+(defun emms-idapi-musicbrainz-process (buffer)
+ "Process response stored in BUFFER. Return BUFFER."
+ (when (or (not buffer)
+ (not (bufferp buffer)))
+ (error "cannot access response buffer"))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (when (not (re-search-forward "HTTP/1.1 200 OK" (line-end-position) t))
+ (error "not a valid HTTP response from server"))
+ buffer))
+
+
+;;; ------------------------------------------------------------------
+;;; Call
+;;; ------------------------------------------------------------------
+(defun emms-idapi-musicbrainz-call (search-term-alist)
+ "Make a call into search service based on SEARCH-TERM-ALIST."
+ (let (buffer
+ ;; Robert Kaye from MusicBrainz said on the 21st of February,
+ ;; 2024, that this format of user agent string is good.
+ (url-user-agent (concat "Emacs_Emms/"
+ emms-version
+ " (https://www.gnu.org/software/emms/)"))
+ (url-string (emms-idapi-musicbrainz-make-search-string
+ search-term-alist)))
+ (setq buffer (url-retrieve-synchronously
+ url-string
+ t t
+ emms-idapi-musicbrainz-url-timeout-seconds))
+ (if (not buffer)
+ (error "call to musicbrainz API timeout or returned nothing")
+ (with-current-buffer buffer
+ (setq emms-idapi-query-local search-term-alist))
+ (setq emms-idapi-musicbrainz-url-buffer buffer))))
+
+(defun emms-idapi-musicbrainz-get-search-string (field)
+ "Return the search string associated with FIELD."
+ (let ((string (alist-get field emms-idapi-musicbrainz-search-string-map)))
+ (when (not string)
+ (error "no associated string for \"%s\" field" field))
+ string))
+
+(defun emms-idapi-musicbrainz-make-search-string (term-alist)
+ (let ((artist (or (alist-get 'info-artist term-alist)
+ (alist-get 'info-albumartist term-alist)))
+ (release (alist-get 'info-album term-alist))
+ (track (alist-get 'info-title term-alist))
+ (reid (alist-get 'reid term-alist))
+ (arid (alist-get 'arid term-alist)))
+ (concat emms-idapi-musicbrainz-root-url
+
+ (cond ((and artist (not release))
+ (format "artist/?query=%s" (url-encode-url (concat "\""
artist "\""))))
+ (release
+ (format "release/?query=release:%s%s%s"
+ (url-encode-url (concat "\"" release "\""))
+ (if artist (url-encode-url (concat " AND artist:\""
artist "\"")) "")
+ (if arid (concat (url-encode-url " AND ") "arid:"
arid) "")))
+ (track
+ (format "recording?query=%sreid:%s"
+ (url-encode-url (concat "\"" track "\""))
+ reid))
+ (t (error "unhandled field %s" term-alist)))
+
+ (format "&limit=%d&fmt=json"
emms-idapi-musicbrainz-response-limit))))
+
+
+;;; ------------------------------------------------------------------
+;;; Interface
+;;; ------------------------------------------------------------------
+(defun emms-idapi-musicbrainz-search (search-term-alist)
+ "IDAPI interface function for searching MusicBrainz service.
+
+ARID limits the search to a MusicBrainz artist id."
+ (when (not (listp search-term-alist))
+ (error "%s is not a list" search-term-alist))
+ (emms-idapi-musicbrainz-process-type-dispatch
+ (emms-idapi-musicbrainz-process-json
+ (emms-idapi-musicbrainz-process
+ (emms-idapi-musicbrainz-call search-term-alist)))))
+
+
+(provide 'emms-idapi-musicbrainz)
+
+;;; emms-idapi-musicbrainz.el ends here
diff --git a/emms-idapi.el b/emms-idapi.el
new file mode 100644
index 0000000000..7898540f49
--- /dev/null
+++ b/emms-idapi.el
@@ -0,0 +1,55 @@
+;;; emms-idapi.el --- EMMS Music ID API support -*- lexical-binding: t; -*-
+;;
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Yoni Rabkin <y...@gnu.org>
+
+;; 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:
+;;
+
+;;; Code:
+(require 'emms-idapi-musicbrainz)
+
+
+(defvar emms-idapi-services-alist
+ '((musicbrainz . ((search-f . emms-idapi-musicbrainz-search)
+ (name . "MusicBrainz")
+ (website . "https://musicbrainz.org/";))))
+ "Association list of services supported by IDAPI.")
+
+(defvar emms-idapi-service nil
+ "The music search service currently in use.")
+
+
+(defun emms-idapi-search (service search-term-alist)
+ "Search against SERVICE for SEARCH-TERM-ALIST."
+ (let ((search-function (alist-get 'search-f
+ (alist-get service
+ emms-idapi-services-alist))))
+ (if (not search-function)
+ (error "`%s' is an unsupported service." service))
+ (funcall search-function search-term-alist)))
+
+
+(provide 'emms-idapi)
+
+;;; emms-idapi.el ends here
diff --git a/emms-setup.el b/emms-setup.el
index 2ce6ed57b3..088b41d632 100644
--- a/emms-setup.el
+++ b/emms-setup.el
@@ -128,7 +128,9 @@ the stable features which come with the Emms distribution."
(require 'emms-playlist-limit)
(require 'emms-librefm-scrobbler)
(require 'emms-librefm-stream)
- (require 'emms-mpris))
+ (require 'emms-mpris)
+ (require 'emms-idapi-musicbrainz)
+ (require 'emms-idapi-browser))
;; setup
(setq emms-playlist-default-major-mode #'emms-playlist-mode)
(add-to-list 'emms-track-initialize-functions #'emms-info-initialize-track)
