|
|
;;; my-emms.el -- Extensions for emms -*- lexical-binding: t -*-
;; Copyright (C) 2023 Free Software Foundation.
;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))
;; This file is part of dotfiles.
;; dotfiles is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;; Public License for more details.
;; You should have received a copy of the GNU Affero General Public
;; License along with dotfiles. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Extensions for emms.
;;; Code:
;;; emms
(require 'emms-playlist-mode)
(require 'my-buffer)
(defun my-emms-switch-to-playlist-buffer ()
(interactive)
(my-switch-to-buffer-matching-major-mode 'emms-playlist-mode))
(require 'emms-player-mpv)
(defun my-emms-mpv-toggle-video ()
(interactive)
(if (member "--no-video" emms-player-mpv-parameters)
(progn
(setq emms-player-mpv-parameters
(remove "--no-video" emms-player-mpv-parameters))
(message "emms: video enabled!"))
(setq emms-player-mpv-parameters
(nconc emms-player-mpv-parameters '("--no-video")))
(message "emms: video disabled!")))
(require 'emms)
(defun my-emms-mpv-toggle-torsocks ()
(interactive)
(emms-pause)
(if (string= "torsocks" emms-player-mpv-command-name)
(progn
(setq emms-player-mpv-command-name (pop emms-player-mpv-parameters))
(message "Will run mpv without torsocks. Please restart mpv."))
(push emms-player-mpv-command-name emms-player-mpv-parameters)
(setq emms-player-mpv-command-name "torsocks")
(message "Will run mpv with torsocks. Please restart mpv")))
;;; do we need this? doesn't emms already have something like this?
(defmacro my-with-current-buffer-as-current-emms-playlist (&rest body)
"Run BODY with the current playlist buffer being the current buffer."
`(let ((saved-buffer emms-playlist-buffer))
(my-emms-playlist-mode-make-current)
,@body
(emms-playlist-set-playlist-buffer saved-buffer)))
(defun my-emms-playlist-save-current-buffer ()
(interactive)
(when (equal major-mode 'emms-playlist-mode)
(my-with-current-buffer-as-current-emms-playlist
(call-interactively 'emms-playlist-save))))
(defun my-emms-maybe-seek-to-last-played ()
(when-let ((last-playing-time
(emms-track-get (emms-playlist-current-selected-track)
'playing-time)))
(emms-seek-to last-playing-time)))
;;; do we need this?
(defun my-emms-playlist-mode-make-current ()
"make the current playlist buffer current"
(interactive)
(when (equal major-mode 'emms-playlist-mode)
(emms-playlist-set-playlist-buffer (current-buffer))
(when (called-interactively-p 'interactive)
(message "%s is the current playlist buffer."
emms-playlist-buffer))))
;; mode line and playing time go together
(defun my-emms-mode-line-enable ()
(interactive)
(emms-mode-line-mode 1)
(emms-playing-time-enable-display))
(defun my-emms-mode-line-disable ()
(interactive)
(emms-mode-line-mode -1)
(emms-playing-time-disable-display))
(defun my-emms-mode-line-toggle ()
(interactive)
(emms-mode-line-mode 'toggle)
(emms-playing-time-display-mode 'toggle))
(defvar my-emms-native-playlists
(directory-files emms-source-file-default-directory t "\\.native$"))
(defun my-emms-playlist-make-buffer-name (playlist)
"Make an emms buffer name from a playlist file name."
(concat "emms-" (file-name-base playlist)))
(defun my-emms-load-from-native (playlist &optional buffer-name)
"Creates an emms playlist buffer with BUFFER-NAME from a native PLAYLIST."
(unless buffer-name (setq buffer-name (my-emms-playlist-make-buffer-name playlist)))
(let ((saved-buffer emms-playlist-buffer))
(with-current-buffer
(or (get-buffer buffer-name)
(emms-playlist-new buffer-name))
(my-emms-playlist-mode-make-current)
(emms-playlist-clear)
(emms-add-native-playlist playlist)
(message (format "%s loaded in buffer %s!"
playlist buffer-name)))
(and saved-buffer (emms-playlist-set-playlist-buffer saved-buffer))))
(defun my-emms-add-directory-files-as-url (dir)
"Add all files under directory DIR as file:// url."
(mapc
(lambda (file)
(emms-add-url (format "file://%s" file)))
(directory-files-recursively (expand-file-name dir) ".*"))
)
(defun my-emms-add-all ()
(interactive)
(mapc 'my-emms-load-from-native my-emms-native-playlists)
(emms-metaplaylist-mode-go))
(defun my-emms-playlist-deduplicate ()
(interactive)
(emms-mark-regexp ".* ([0-9])\\.[a-zA-Z0-9]+" nil)
(emms-mark-delete-marked-tracks))
(defun my-emms-reload (from to type)
"Reload playlist buffer TO from files of url lists
The content of a file in FROM is a list of urls. TYPE is
either 'audio or 'video
"
(interactive)
(when (memq (get-buffer to) emms-playlist-buffers)
(emms-playlist-set-playlist-buffer to)
(with-current-buffer to (emms-playlist-clear))
(let ((emms-track-initialize-functions nil))
(my-emms-add-url-lists from
(alist-get type my-extension-types)))
(with-current-buffer to (emms-sort))))
(defun my-emms-players-preference (track players)
"If audio, use first player, otherwise second."
(let ((name (emms-track-name track)))
(if (and (length> players 1)
(string-prefix-p "file://" name)
(member (file-name-extension name)
'("mkv" "ogv" "avi" "webm")))
'emms-player-vlc
'emms-player-mpv)))
(defvar my-emms-playlist-alist nil
"alist controlling playlists, where the cdr of each item is an also an alist,
with possible keys 'source and 'type.
'source is a list of files of url lists.
'type is one of 'audio, 'video, or 'audiovideo")
(defun my-emms-playlist-reload-current ()
"Reload the current playlist using info from `my-emms-playlist-alist'"
(interactive)
(let* ((name (buffer-name emms-playlist-buffer))
(info (alist-get name my-emms-playlist-alist nil nil #'equal)))
(my-emms-reload (alist-get 'source info) name (alist-get 'type info))))
(defun my-emms-save-all ()
(interactive)
(let ((saved-buffer emms-playlist-buffer)
(saved-overwrite emms-source-playlist-ask-before-overwrite))
(setq emms-source-playlist-ask-before-overwrite nil)
(dolist (pair my-emms-native-playlists)
(let ((file (car pair))
(buffer (cadr pair)))
(when (get-buffer buffer)
(with-current-buffer buffer
(my-emms-playlist-mode-make-current)
(emms-playlist-save 'native file)))))
(emms-playlist-set-playlist-buffer saved-buffer)
(setq emms-source-playlist-ask-before-overwrite saved-overwrite)))
(defun my-emms-add-process-output-url (process output)
"A process filter extracting url from a jq output."
(let ((left (string-match "\".*\"" output)))
(emms-add-url (substring output (1+ left) (1- (match-end 0))))))
(defun my-emms-add-ytdl-playlist (url buffer-name)
"Adds all videos on a web playlist from URL using ytdl.
URL could be link to a playlist, a playlist id, videos of a channel, or a
list of playlists on a channel
"
(interactive "syoutube-dl playlist url: \nsemms buffer name: ")
(unless (get-buffer buffer-name)
(emms-playlist-new buffer-name))
(emms-playlist-set-playlist-buffer buffer-name)
(set-process-filter
(start-process-shell-command
"ytdl-emms" nil
(format "yt-dlp -j %s | jq '.webpage_url'" url))
'my-emms-add-process-output-url))
(defvar my-ytdl-supported-domains
'("youtu.be" "youtube.com" "yewtu.be" "framatube.org" "pbs.org" "v.redd.it"
"soundcloud.com"))
(defvar my-ytdl-supported-domains-re
(string-join my-ytdl-supported-domains "\\|"))
(defvar my-emms-incoming-playlists
'((audio . "emms-incoming-audios")
(video . "emms-incoming-videos")
(nil . "emms-incoming"))
"EMMS playlists to insert incoming items.")
(defun my-emms-enqueue-buffer-ytdl-incoming (media-type)
(let ((current-emms-buffer emms-playlist-buffer)
(links (link-gopher-get-all-links-in-buffer my-ytdl-supported-domains-re)))
(with-current-buffer (alist-get media-type my-emms-incoming-playlists)
(my-emms-playlist-mode-make-current)
(dolist (url links)
(emms-add-url url)))
(with-current-buffer current-emms-buffer
(my-emms-playlist-mode-make-current))))
(defun my-emms-playlist-set-info-title-at-point (title)
(when (equal major-mode 'emms-playlist-mode)
(let ((track (get-text-property (point) 'emms-track)))
(emms-track-set track 'info-title title))))
(defun my-emms-add-url-region (from to &optional filter-exts)
"Adds a list of urls to emms separated by newlines.
filter extensions from filter-exts."
(interactive (list (region-beginning) (region-end)))
(mapc 'emms-add-url
(seq-filter
(lambda (s) (and
(not (equal s ""))
(or (not filter-exts)
(member
(when (string-match "^.*\\.\\(.*\\)$" s)
(match-string 1 s))
filter-exts))))
(split-string
(buffer-substring-no-properties from to) "
"))))
(defun my-emms-add-url-list (file)
(interactive (list (read-file-name "Add url list from file: ")))
(with-temp-buffer
(let ((coding-system-for-read 'utf-8))
(find-file file))
(my-emms-add-url-region (point-min) (point-max))))
(defun my-emms-add-url-lists (files &optional filter-exts)
(with-temp-buffer
(let ((coding-system-for-read 'utf-8))
(mapc 'insert-file-contents (reverse files)))
(my-emms-add-url-region (point-min) (point-max) filter-exts)))
(defun my-emms-ytdl-current-buffer-command ()
(interactive)
(let ((results))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(push (format "'%s'" (alist-get 'name (emms-playlist-track-at (point))))
results)
(beginning-of-line 2)))
(kill-new (concat "torsocks yt-dlp -w -x -o \"%(title)s.%(ext)s\" "
(string-join (reverse results) " ")))
(message "Copied yt-dlp command of downloading %d urls to the kill ring"
(length results))))
;; TODO: use emms-playlist-current-selected-track instead
(defun my-emms-get-current-track ()
(with-current-buffer emms-playlist-buffer
(emms-playlist-mode-center-current)
(emms-playlist-track-at (point))))
(defvar my-emms-i3bar-file (locate-user-emacs-file "emms-i3bar")
"File to write current playing to which i3bar reads")
(defun my-emms-get-display-name (track)
"Return the display name of a track.
The display name is either the info-title, or the display name of
the filename."
(or (alist-get 'info-title track)
(when-let ((name
(alist-get 'name track)))
(my-emms-get-display-name-1 name))))
(defun my-emms-get-display-name-1 (name)
"Return the display name of a filename NAME.
The display name is the last three components of the filename,
assuming the filesystem hierarchy is arranged in
artist/album/track."
(replace-regexp-in-string "^\\(.*/\\)\\(.*/.*/.*\\)" "\\2" name))
(defun my-emms-output-current-track-to-i3bar-file ()
(let ((current-track
(my-emms-get-display-name (emms-playlist-current-selected-track))))
(with-temp-buffer
(when current-track (insert current-track))
(let ((inhibit-message t))
(write-file my-emms-i3bar-file)))))
(defun my-emms-output-current-track-to-i3bar-file-no-error ()
(ignore-error (my-emms-output-current-track-to-i3bar-file)))
(defun my-emms-get-current-track-name ()
(emms-track-get (my-emms-get-current-track) 'name))
(defun my-emms-print-current-track-display-name ()
(interactive)
(with-current-buffer emms-playlist-buffer
(emms-playlist-mode-center-current)
(message (my-get-current-line-no-properties))))
(defun my-emms-print-current-track-name ()
(interactive)
(message
(concat "current track: "
(my-emms-get-current-track-name))))
(defun my-emms-playlist-kill-track-name-at-point ()
(interactive)
(let ((name (emms-track-get (emms-playlist-track-at (point)) 'name)))
(kill-new name)
(message "Copied %s" name)))
(defun my-emms-kill-current-track-name ()
(interactive)
(let ((name (my-emms-get-current-track-name)))
(kill-new name)
(message "Copied %s" name)))
(defvar my-emms-favourites-playlist
(file-name-concat emms-directory "favourites.native"))
(defun my-emms-append-current-track-to-favourites ()
(interactive)
(with-temp-buffer
(find-file my-emms-favourites-playlist)
(goto-char (1+ (point-min)))
(beginning-of-line 3)
(insert (prin1-to-string (my-emms-get-current-track)))
(insert "\n")
(save-buffer)
(message "Added %s to %s!"
(my-emms-print-current-track-display-name)
my-emms-favourites-playlist)
(kill-buffer))
(my-emms-load-from-native my-emms-favourites-playlist
(my-emms-playlist-make-buffer-name
my-emms-favourites-playlist)))
;;; random album in emms
(defun my-my-emms-current-album-name ()
(file-name-directory (my-emms-get-current-track-name)))
(defun my-emms-next-track-or-random-album ()
(interactive)
(let ((current-album (my-my-emms-current-album-name)))
(when emms-player-playing-p (emms-stop))
(emms-playlist-current-select-next)
(if (string-equal (my-my-emms-current-album-name) current-album)
(emms-start)
(my-emms-random-album nil))))
(defvar-local my-emms-albums-cache (vector))
(defun my-emms-save-albums-cache ()
(let ((album-set (make-hash-table :test 'equal))
(album-list))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(puthash (file-name-directory
(emms-track-get (emms-playlist-track-at (point)) 'name))
nil album-set)
(forward-line)))
(maphash (lambda (key _) (push key album-list)) album-set)
(setq my-emms-albums-cache (vconcat album-list))
(message "Emms album cache updated.")))
(defun my-emms-get-random-album ()
"Returns a random album from the current playlist.
We put a low weight on discovery album, currently any directory
under /zzz-seren/."
(let ((album
(elt my-emms-albums-cache (random (length my-emms-albums-cache)))))
(while (and (string-match "/zzz-seren/" album)
(>= (random 100) 4))
(setq album
(elt my-emms-albums-cache (random (length my-emms-albums-cache)))))
album))
(defun my-emms-random-album (update-album)
(interactive "P")
(with-current-emms-playlist
(when (or update-album (length= my-emms-albums-cache 0))
(my-emms-save-albums-cache))
(when emms-player-playing-p (emms-stop))
(let ((saved-position (point)))
(goto-char (point-min))
(if (search-forward
(my-emms-get-random-album)
nil t)
(emms-playlist-mode-play-current-track)
(goto-char saved-position)
(error "Cannot play random album")))))
;;; override the minor mode
;;;###autoload
(define-minor-mode emms-playing-time-display-mode
"Minor mode to display playing time on mode line."
:global t
;; When disabling the mode, don't disable `emms-playing-time-display-mode'
;; since that may be used by other packages.
)
;; do we really need this? emms already has some dired support builtin
(require 'dired)
(defun my-dired-add-to-emms ()
(interactive)
(let ((target (dired-get-filename)))
(or (emms-add-file target) (emms-add-directory target))))
(defun my-emms-playlist-delete-at-point ()
(interactive)
(let* ((track (emms-playlist-track-at (point)))
(type (emms-track-type track))
(name (emms-track-name track)))
(cond ((and (eq type 'url)
(string-match "^file://\\(.*\\)" name))
(let ((file-name (match-string 1 name)))
(when (and
(not (file-attribute-type (file-attributes file-name)))
(y-or-n-p (format "Delete file %s?" file-name)))
(delete-file file-name)
(message "File deleted: %s" name)
(emms-playlist-mode-kill-track))))
(t (message "cannot delete %s" name)))))
;; wip
(defun emms-download-at-point (audio-only)
(interactive "P")
(let* ((track (emms-playlist-track-at (point)))
(type (emms-track-get track 'type))
(url (emms-track-get track 'name)))
(cond
((not (equal type 'url))
(error "Not a url type track!"))
((not (or (string-prefix-p "http://" url)
(string-prefix-p "https://" url)))
(error "Not http(s) scheme!"))
(t (my-shell-with-directory "~/Downloads")))
))
;; Used to override `emms-track-simple-description' to fallback to description
(defun my-emms-track-simple-description (track)
"Simple function to give a user-readable description of a track.
If it's a file track, just return the file name. Otherwise,
return the type and the name with a colon in between.
Hex-encoded characters in URLs are replaced by the decoded
character."
(let ((type (emms-track-type track)))
(cond ((emms-track-get track 'description)
(emms-track-get track 'description))
((eq 'file type)
(emms-track-name track))
((eq 'url type)
(emms-format-url-track-name (emms-track-name track)))
(t (concat (symbol-name type)
": " (emms-track-name track))))))
(defvar my-emms-score-delta 1)
(defun my-emms-score-up-playing ()
"Increase score by `my-emms-score-delta', then reset it to 1."
(emms-score-change-score
my-emms-score-delta
(my-emms-get-display-name-1 (emms-score-current-selected-track-filename)))
(setq my-emms-score-delta 1))
(defun my-emms-score-up-chosen-bonus ()
"Bonus score up if the track is started intentionally.
If the last command is `emms-playlist-mode-play-smart', then set
`my-emms-score-delta' to 2."
(when (eq last-command 'emms-playlist-mode-play-smart)
(setq my-emms-score-delta 2)))
(defun my-emms-wrapped ()
"Print top 5 scored tracks."
(interactive)
(let (keys)
(maphash (lambda (k _) (push k keys)) emms-score-hash)
(sort keys (lambda (k1 k2)
(> (cl-second (gethash k1 emms-score-hash))
(cl-second (gethash k2 emms-score-hash)))))
(message "Top 5: %s" (string-join (take 5 keys) "\n"))))
(provide 'my-emms)
;;; my-emms.el ends here
|