|
|
;;; db-music.el -- Music related stuff -*- lexical-binding: t -*-
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
(require 'dash)
|
|
|
(require 'subr-x)
|
|
|
(require 'seq)
|
|
|
(require 'emms)
|
|
|
(require 'emms-source-file)
|
|
|
(require 'emms-playlist-sort)
|
|
|
(require 'emms-info)
|
|
|
(require 'hydra)
|
|
|
(require 'db-emms)
|
|
|
|
|
|
(defgroup db-music nil
|
|
|
"General configurations for music-related functionality."
|
|
|
:prefix "db-music"
|
|
|
:group 'convenience
|
|
|
:tag "db-music")
|
|
|
|
|
|
|
|
|
;; Autogeneration of Playlist
|
|
|
|
|
|
(defcustom db/auto-playlist-file-function #'db/play-auto-playlist-from-git-annex-find
|
|
|
"Function returning all music files of an automatically generated playlist.
|
|
|
|
|
|
This function should return a list of file names of music files."
|
|
|
:group 'db-music
|
|
|
:type 'function)
|
|
|
|
|
|
(defun db/play-auto-playlist ()
|
|
|
"Automatically generate playlist and play it.
|
|
|
|
|
|
Will use `db/auto-playlist-file-function’ for generating that
|
|
|
playlist. Current backend is EMMS."
|
|
|
(interactive)
|
|
|
(db/-emms-playlist-from-files (funcall db/auto-playlist-file-function)))
|
|
|
|
|
|
;; Idea: make this customizable, so that we can later switch to another backend
|
|
|
;; if necessary
|
|
|
|
|
|
(defun db/-emms-playlist-from-files (files)
|
|
|
"Generate EMMS playlist from FILES.
|
|
|
|
|
|
Shuffle it and start playing it afterwards."
|
|
|
(when (seq-empty-p files)
|
|
|
(user-error "List of files is empty, nothing to do"))
|
|
|
(save-window-excursion
|
|
|
(let ((music-buffer-name "*EMMS Playlist* -- Personal"))
|
|
|
(unless (get-buffer music-buffer-name)
|
|
|
(emms-playlist-new music-buffer-name))
|
|
|
(with-current-buffer (get-buffer music-buffer-name)
|
|
|
(emms-stop)
|
|
|
(emms-playlist-set-playlist-buffer)
|
|
|
(emms-playlist-current-clear)
|
|
|
(dolist (track files)
|
|
|
(emms-playlist-current-insert-source 'emms-insert-file track))
|
|
|
(goto-char (point-min))
|
|
|
(emms-shuffle)
|
|
|
(emms-playlist-select-first)
|
|
|
(emms-start)))))
|
|
|
|
|
|
(defun db/playlist-files-from-git-annex-find (match-expression)
|
|
|
"Generate list of files from git annex find on MATCH-EXPRESSION.
|
|
|
|
|
|
Prompts for MATCH-EXPRESSION when called interactively.
|
|
|
Generates a list of absolute file names that is comprised of
|
|
|
exactly those files that match it. Assumes the default EMMS file
|
|
|
directory as specified by `emms-source-file-default-directory’ to
|
|
|
be part of a git-annex repository, complaining otherwise."
|
|
|
(interactive "smatch expression: ")
|
|
|
(let* ((default-directory emms-source-file-default-directory))
|
|
|
(->> (split-string (with-output-to-string
|
|
|
(with-current-buffer standard-output
|
|
|
(let ((return-value (apply #'call-process
|
|
|
"git" nil t nil
|
|
|
"annex" "find"
|
|
|
(split-string match-expression))))
|
|
|
(unless (zerop return-value)
|
|
|
(error "Call to `git-annex-find’ failed: %s"
|
|
|
(buffer-string))))))
|
|
|
"\n")
|
|
|
(cl-remove-if-not #'(lambda (path)
|
|
|
(and (not (string-empty-p path))
|
|
|
(file-exists-p path)
|
|
|
(file-readable-p path))))
|
|
|
(mapcar #'(lambda (path)
|
|
|
(expand-file-name
|
|
|
path
|
|
|
emms-source-file-default-directory))))))
|
|
|
|
|
|
(defun db/play-auto-playlist-from-git-annex-find ()
|
|
|
"Query for match expression and play resulting audio files.
|
|
|
|
|
|
The match expression must be suitable for git-annex to find the
|
|
|
desired files. See `db/playlist-files-from-git-annex-find’ for
|
|
|
more details."
|
|
|
(interactive)
|
|
|
(db/-emms-playlist-from-files
|
|
|
(call-interactively #'db/playlist-files-from-git-annex-find)))
|
|
|
|
|
|
(defhydra music-control (:color red :hint none)
|
|
|
"
|
|
|
Playing: %s(db/emms-track-status)
|
|
|
|
|
|
_n_: ?n? _p_: ?p?
|
|
|
_RET_: ?RET? _M_: ?M?
|
|
|
_-_: lower volume _+_: ?+?
|
|
|
_P_: ?P?
|
|
|
|
|
|
"
|
|
|
("n" emms-next "next")
|
|
|
("p" emms-previous "previous")
|
|
|
("RET" emms-pause "play/pause")
|
|
|
("s" emms-show "show title")
|
|
|
("-" emms-volume-lower "lower volume")
|
|
|
("+" emms-volume-raise "raise volume")
|
|
|
("M" emms "show playlist")
|
|
|
("P" (db/play-auto-playlist)
|
|
|
"Play automatically generated playlist"))
|
|
|
|
|
|
|
|
|
|
|
|
;; Radio Stations
|
|
|
|
|
|
(defcustom db/radio-stations
|
|
|
'(("RBB RadioEins" .
|
|
|
"http://rbb-radioeins-live.cast.addradio.de/rbb/radioeins/live/mp3/48/stream.mp3")
|
|
|
("Deutschlandfunk" .
|
|
|
"http://st01.dlf.de/dlf/01/64/mp3/stream.mp3")
|
|
|
("Deutschlandradio Kultur" .
|
|
|
"https://st02.sslstream.dlf.de/dlf/02/64/mp3/stream.mp3")
|
|
|
("Deutschlandfunk Nova" .
|
|
|
"https://st03.sslstream.dlf.de/dlf/03/64/mp3/stream.mp3")
|
|
|
("DR P7" .
|
|
|
"http://live-icy.gss.dr.dk/A/A21L.mp3.m3u")
|
|
|
("BBC1 -- Mainstream" .
|
|
|
"http://bbcmedia.ic.llnwd.net/stream/bbcmedia_radio1_mf_p")
|
|
|
("BBC2 -- Adult Contemporary" .
|
|
|
"http://bbcmedia.ic.llnwd.net/stream/bbcmedia_radio2_mf_p")
|
|
|
("BBC4 -- Info, Drama, Documentation" .
|
|
|
"http://bbcmedia.ic.llnwd.net/stream/bbcmedia_radio4fm_mf_p")
|
|
|
("BBC6 -- Music" .
|
|
|
"http://bbcmedia.ic.llnwd.net/stream/bbcmedia_6music_mf_p")
|
|
|
("BBC World Service" .
|
|
|
"http://bbcwssc.ic.llnwd.net/stream/bbcwssc_mp1_ws-eieuk")
|
|
|
("NDR1 Niedersachsen" .
|
|
|
"https://ndr-ndr1niedersachsen-hannover.sslcast.addradio.de/ndr/ndr1niedersachsen/hannover/mp3/128/stream.mp3"))
|
|
|
"An alist of radio station names and a corresponding URL."
|
|
|
:group 'db-music
|
|
|
:type '(alist :key-type (string :tag "Radio Station")
|
|
|
:value-type (string :tag "URL")))
|
|
|
|
|
|
(defun db/play-radio-stations ()
|
|
|
"Prompt for radio station and play the corresponding URL using EMMS.
|
|
|
Candidates are taken from `db/radio-stations'."
|
|
|
(interactive)
|
|
|
(-> (completing-read "Station: " db/radio-stations nil t)
|
|
|
(assoc db/radio-stations)
|
|
|
cdr
|
|
|
emms-play-url))
|
|
|
|
|
|
|
|
|
;; Playlist management
|
|
|
|
|
|
(cl-defun db/write-m3u-playlist-from-git-annex-find
|
|
|
(file match-expression
|
|
|
&optional (base-dir emms-source-file-default-directory) overwrite)
|
|
|
"Write an M3U playlist to FILE based on a git-annex MATCH-EXPRESSION.
|
|
|
The playlist will contain all files found by git-annex-find using
|
|
|
MATCH-EXPRESSION. Conduct search with git-annex-find in
|
|
|
BASE-DIR. Query for overwrite if FILE already exists, unless
|
|
|
OVERWRITE is non-nil."
|
|
|
(interactive "FFile name of playlist: \nsPlaylist name: \nsgit annex match-expression: ")
|
|
|
(let ((base-dir (expand-file-name base-dir)))
|
|
|
(unless (file-accessible-directory-p base-dir)
|
|
|
(user-error "Error: “%s” is not a valid directory" base-dir))
|
|
|
(unless (or (not (file-exists-p file))
|
|
|
overwrite
|
|
|
(yes-or-no-p (format "File %s already exists, overwrite?" file)))
|
|
|
(user-error "Error: %s exists and shall not be overwritten, aborting" file))
|
|
|
(let ((default-directory base-dir))
|
|
|
(let* ((return-code nil)
|
|
|
(output (with-output-to-string
|
|
|
(with-current-buffer standard-output
|
|
|
(setq return-code (apply #'call-process
|
|
|
"git" nil t nil
|
|
|
"annex" "find"
|
|
|
(split-string match-expression)))))))
|
|
|
(if (not (zerop return-code))
|
|
|
(error "%s" output)
|
|
|
(let ((emms-source-playlist-ask-before-overwrite nil)
|
|
|
(emms-temp-playlist-buffer (emms-playlist-new " *EMMS Playlist Export*"))
|
|
|
(emms-info-asynchronously nil))
|
|
|
(with-current-buffer emms-temp-playlist-buffer
|
|
|
(let ((emms-playlist-buffer (current-buffer)))
|
|
|
(emms-playlist-clear)
|
|
|
(dolist (track (split-string output "[\n\r]" 'omit-nulls))
|
|
|
(emms-insert-file track))
|
|
|
(emms-playlist-sort-by-info-title)
|
|
|
(emms-playlist-sort-by-info-artist)
|
|
|
;; When writing the playlist, we simulate the current buffer to be
|
|
|
;; the current playlist, as otherwise `emms-playlist-save' will
|
|
|
;; ask for confirmation.
|
|
|
(emms-playlist-save 'm3u file)))
|
|
|
(kill-buffer emms-temp-playlist-buffer)
|
|
|
|
|
|
;; Convert absolute file names to relative file names
|
|
|
(with-current-buffer (or (find-buffer-visiting file)
|
|
|
(find-file-noselect file))
|
|
|
;; Make sure the current buffer is up to date with the file on
|
|
|
;; disk, in case it had been visited before
|
|
|
(revert-buffer 'ignore-auto 'noconfirm)
|
|
|
(goto-char (point-min))
|
|
|
(while (re-search-forward "^.+$" nil 'noerror)
|
|
|
(replace-match (file-relative-name (match-string 0))))
|
|
|
(save-buffer))))))))
|
|
|
|
|
|
(defun db/update-playlist-files ()
|
|
|
"Update personal playlist files."
|
|
|
(interactive)
|
|
|
(message "Update favorites playlist")
|
|
|
(db/write-m3u-playlist-from-git-annex-find
|
|
|
"~/Documents/media/audio/others/daniels-favorite.m3u"
|
|
|
"../songs/ --metadata rating-daniel>=0.9"
|
|
|
"~/Documents/media/audio/others/"
|
|
|
'overwrite)
|
|
|
(message "Update work playlist")
|
|
|
(db/write-m3u-playlist-from-git-annex-find
|
|
|
"~/Documents/media/audio/others/daniels-work-list.m3u"
|
|
|
"../songs/ --metadata db-work=include"
|
|
|
"~/Documents/media/audio/others/"
|
|
|
'overwrite))
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'db-music)
|
|
|
|
|
|
;;; db-music ends here
|
