|
|
;;; 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
|
|
|
|
