You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

242 lines
9.3 KiB

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

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