path: root/emacs/.emacs.d/lisp/my/my-emms.el

;;; 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-all ()
  (interactive)
  (mapc 'my-emms-load-from-native my-emms-native-playlists)
  (emms-metaplaylist-mode-go))

(defun my-emms-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))))

(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)
  (or (alist-get 'info-title track)
      (when-let ((name
                  (alist-get 'name 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-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
           (elt my-emms-albums-cache (random (length my-emms-albums-cache)))
           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))))))

(provide 'my-emms)
;;; my-emms.el ends here