Inserting a null string results in all files in the current buffer to be added to that playlist. Finding this bug was tricky!
227 lines
8.6 KiB
EmacsLisp
227 lines
8.6 KiB
EmacsLisp
;;; 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 '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 that has to return a list of all music files that
|
||
should be included in the auto playlist."
|
||
:group 'db-music
|
||
:type 'function)
|
||
|
||
(defun db/play-auto-playlist ()
|
||
"Generate playlist using `db/auto-playlist-file-function’ and
|
||
start playing it.
|
||
|
||
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 ()
|
||
"Interactively query user for a git-annex match expression and
|
||
play resulting list of audio 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 (not overwrite))
|
||
(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)))))))
|
||
|
||
(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
|