My Emacs configuration.
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.

237 lines
9.1 KiB

;;; 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."
(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"))
(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)
(dolist (track files)
(emms-playlist-current-insert-source 'emms-insert-file track))
(goto-char (point-min))
(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"
(cl-remove-if-not #'(lambda (path)
(and (not (string-empty-p path))
(file-exists-p path)
(file-readable-p path))))
(mapcar #'(lambda (path)
(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."
(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" .
("Deutschlandfunk" .
("Deutschlandradio Kultur" .
("Deutschlandfunk Nova" .
("DR P7" .
("BBC1 -- Mainstream" .
("BBC2 -- Adult Contemporary" .
("BBC4 -- Info, Drama, Documentation" .
("BBC6 -- Music" .
("BBC World Service" .
("NDR1 Niedersachsen" .
"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'."
(-> (completing-read "Station: " db/radio-stations nil t)
(assoc db/radio-stations)
;; 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))
(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)))
(dolist (track (split-string output "[\n\r]" 'omit-nulls))
(emms-insert-file track))
;; 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))))
(defun db/update-playlist-files ()
"Update personal playlist files."
(message "Update favorites playlist")
"../songs/ --metadata rating-daniel>=0.9"
(message "Update work playlist")
"../songs/ --metadata db-work=include"
(provide 'db-music)
;;; db-music ends here