Sort tracks in auto-generated playlists by title and author

For this, the playlist export of EMMS is used to enable sorting by track
metadata.  The current implementation is a first try and may contain some bugs
when track metadata is not readily available.
This commit is contained in:
Daniel - 2021-02-24 13:10:08 +01:00
parent c0986d240b
commit b148c41c98
No known key found for this signature in database
GPG Key ID: 1C7071A75BB72D64
1 changed files with 38 additions and 26 deletions

View File

@ -162,14 +162,13 @@ Candidates are taken from `db/radio-stations'."
;; Playlist management ;; Playlist management
(cl-defun db/write-m3u-playlist-from-git-annex-find (cl-defun db/write-m3u-playlist-from-git-annex-find
(file name match-expression (file match-expression
&optional (base-dir emms-source-file-default-directory) overwrite) &optional (base-dir emms-source-file-default-directory) overwrite)
"Write an M3U playlist to FILE with NAME containing all files "Write an M3U playlist to FILE based on a git-annex MATCH-EXPRESSION.
found by git-annex-find using MATCH-EXPRESSION. NAME will be The playlist will contain all files found by git-annex-find using
written to the M3U playlist using the non-standard #PLAYLIST: MATCH-EXPRESSION. Conduct search with git-annex-find in
directive. Conduct search with git-annex-find in BASE-DIR. BASE-DIR. Query for overwrite if FILE already exists, unless
Query for overwrite if FILE already exists, unless OVERWRITE is OVERWRITE is non-nil."
non-nil."
(interactive "FFile name of playlist: \nsPlaylist name: \nsgit annex match-expression: ") (interactive "FFile name of playlist: \nsPlaylist name: \nsgit annex match-expression: ")
(let ((base-dir (expand-file-name base-dir))) (let ((base-dir (expand-file-name base-dir)))
(unless (file-accessible-directory-p base-dir) (unless (file-accessible-directory-p base-dir)
@ -177,34 +176,47 @@ non-nil."
(unless (or (not (file-exists-p file)) (unless (or (not (file-exists-p file))
overwrite overwrite
(yes-or-no-p (format "File %s already exists, overwrite?" file))) (yes-or-no-p (format "File %s already exists, overwrite?" file)))
(user-error "Error: %s exists and shall not be overwritten, aborting." file)) (user-error "Error: %s exists and shall not be overwritten, aborting" file))
(let ((default-directory base-dir)) (let ((default-directory base-dir))
(with-temp-buffer (let* ((return-code nil)
(insert "#EXTM3U\n") (output (with-output-to-string
(insert (format "#PLAYLIST: %s\n" name)) (with-current-buffer standard-output
(let* ((return-code nil) (setq return-code (apply #'call-process
(output (with-output-to-string "git" nil t nil
(with-current-buffer standard-output "annex" "find"
(setq return-code (apply #'call-process (split-string match-expression)))))))
"git" nil t nil (if (not (zerop return-code))
"annex" "find" (error "%s" output)
(split-string match-expression))))))) (let ((emms-source-playlist-ask-before-overwrite (not overwrite))
(if (not (zerop return-code)) (emms-temp-playlist-buffer (emms-playlist-new " *EMMS Playlist Export*")))
(error "%s" output) (with-current-buffer emms-temp-playlist-buffer
(insert output) (emms-playlist-clear)
(write-file file))))))) (dolist (track (split-string output "[\n\r]+"))
(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.
(with-current-emms-playlist
(emms-playlist-save 'm3u file)))
(kill-buffer emms-temp-playlist-buffer)))))))
(defun db/update-playlist-files () (defun db/update-playlist-files ()
"Update personal playlist files." "Update personal playlist files."
(interactive) (interactive)
(message "Update favorites playlist") (message "Update favorites playlist")
(db/write-m3u-playlist-from-git-annex-find (db/write-m3u-playlist-from-git-annex-find
"~/Documents/media/audio/others/daniels-favorite.m3u" "Daniel's Favorites" "~/Documents/media/audio/others/daniels-favorite.m3u"
"../songs/ --metadata rating-daniel>=0.9" "~/Documents/media/audio/others/" t) "../songs/ --metadata rating-daniel>=0.9"
"~/Documents/media/audio/others/"
'overwrite)
(message "Update work playlist") (message "Update work playlist")
(db/write-m3u-playlist-from-git-annex-find (db/write-m3u-playlist-from-git-annex-find
"~/Documents/media/audio/others/daniels-work-list.m3u" "Daniel's Work Music" "~/Documents/media/audio/others/daniels-work-list.m3u"
"../songs/ --metadata db-work=include" "~/Documents/media/audio/others/" t)) "../songs/ --metadata db-work=include"
"~/Documents/media/audio/others/"
'overwrite))