From a2ec9082998918158df250c1906d0f6c0c4889db Mon Sep 17 00:00:00 2001 From: bard Date: Sun, 8 Oct 2023 15:17:31 -0400 Subject: emms package --- bookmarks | 7 +- elisp/emms-bookmarks.el | 153 +++ elisp/emms-browser.el | 2191 ++++++++++++++++++++++++++++++++++++ elisp/emms-cache.el | 193 ++++ elisp/emms-compat.el | 185 +++ elisp/emms-cue.el | 120 ++ elisp/emms-history.el | 131 +++ elisp/emms-i18n.el | 180 +++ elisp/emms-info-exiftool.el | 106 ++ elisp/emms-info-libtag.el | 113 ++ elisp/emms-info-metaflac.el | 105 ++ elisp/emms-info-mp3info.el | 100 ++ elisp/emms-info-native.el | 982 ++++++++++++++++ elisp/emms-info-ogginfo.el | 83 ++ elisp/emms-info-opusinfo.el | 83 ++ elisp/emms-info-spc.el | 95 ++ elisp/emms-info-tinytag.el | 117 ++ elisp/emms-info.el | 138 +++ elisp/emms-jack.el | 359 ++++++ elisp/emms-last-played.el | 123 ++ elisp/emms-later-do.el | 86 ++ elisp/emms-librefm-scrobbler.el | 333 ++++++ elisp/emms-librefm-stream.el | 384 +++++++ elisp/emms-lyrics.el | 576 ++++++++++ elisp/emms-maint.el | 3 + elisp/emms-mark.el | 295 +++++ elisp/emms-metaplaylist-mode.el | 242 ++++ elisp/emms-mode-line-icon.el | 86 ++ elisp/emms-mode-line.el | 157 +++ elisp/emms-mpris.el | 575 ++++++++++ elisp/emms-player-mpd.el | 1361 ++++++++++++++++++++++ elisp/emms-player-mpg321-remote.el | 225 ++++ elisp/emms-player-mplayer.el | 81 ++ elisp/emms-player-mpv.el | 915 +++++++++++++++ elisp/emms-player-simple.el | 207 ++++ elisp/emms-player-vlc.el | 86 ++ elisp/emms-player-xine.el | 92 ++ elisp/emms-playing-time.el | 251 +++++ elisp/emms-playlist-limit.el | 223 ++++ elisp/emms-playlist-mode.el | 627 +++++++++++ elisp/emms-playlist-sort.el | 226 ++++ elisp/emms-score.el | 271 +++++ elisp/emms-setup.el | 200 ++++ elisp/emms-show-all.el | 125 ++ elisp/emms-source-file.el | 309 +++++ elisp/emms-source-playlist.el | 502 +++++++++ elisp/emms-stream-info.el | 30 + elisp/emms-streams.el | 178 +++ elisp/emms-tag-editor.el | 908 +++++++++++++++ elisp/emms-tag-tracktag.el | 77 ++ elisp/emms-url.el | 114 ++ elisp/emms-volume-amixer.el | 94 ++ elisp/emms-volume-mixerctl.el | 80 ++ elisp/emms-volume-pulse.el | 127 +++ elisp/emms-volume-sndioctl.el | 72 ++ elisp/emms-volume.el | 171 +++ elisp/emms.el | 1623 ++++++++++++++++++++++++++ 57 files changed, 17475 insertions(+), 1 deletion(-) create mode 100644 elisp/emms-bookmarks.el create mode 100644 elisp/emms-browser.el create mode 100644 elisp/emms-cache.el create mode 100644 elisp/emms-compat.el create mode 100644 elisp/emms-cue.el create mode 100644 elisp/emms-history.el create mode 100644 elisp/emms-i18n.el create mode 100644 elisp/emms-info-exiftool.el create mode 100644 elisp/emms-info-libtag.el create mode 100644 elisp/emms-info-metaflac.el create mode 100644 elisp/emms-info-mp3info.el create mode 100644 elisp/emms-info-native.el create mode 100644 elisp/emms-info-ogginfo.el create mode 100644 elisp/emms-info-opusinfo.el create mode 100644 elisp/emms-info-spc.el create mode 100644 elisp/emms-info-tinytag.el create mode 100644 elisp/emms-info.el create mode 100644 elisp/emms-jack.el create mode 100644 elisp/emms-last-played.el create mode 100644 elisp/emms-later-do.el create mode 100644 elisp/emms-librefm-scrobbler.el create mode 100644 elisp/emms-librefm-stream.el create mode 100644 elisp/emms-lyrics.el create mode 100644 elisp/emms-maint.el create mode 100644 elisp/emms-mark.el create mode 100644 elisp/emms-metaplaylist-mode.el create mode 100644 elisp/emms-mode-line-icon.el create mode 100644 elisp/emms-mode-line.el create mode 100644 elisp/emms-mpris.el create mode 100644 elisp/emms-player-mpd.el create mode 100644 elisp/emms-player-mpg321-remote.el create mode 100644 elisp/emms-player-mplayer.el create mode 100644 elisp/emms-player-mpv.el create mode 100644 elisp/emms-player-simple.el create mode 100644 elisp/emms-player-vlc.el create mode 100644 elisp/emms-player-xine.el create mode 100644 elisp/emms-playing-time.el create mode 100644 elisp/emms-playlist-limit.el create mode 100644 elisp/emms-playlist-mode.el create mode 100644 elisp/emms-playlist-sort.el create mode 100644 elisp/emms-score.el create mode 100644 elisp/emms-setup.el create mode 100644 elisp/emms-show-all.el create mode 100644 elisp/emms-source-file.el create mode 100644 elisp/emms-source-playlist.el create mode 100644 elisp/emms-stream-info.el create mode 100644 elisp/emms-streams.el create mode 100644 elisp/emms-tag-editor.el create mode 100644 elisp/emms-tag-tracktag.el create mode 100644 elisp/emms-url.el create mode 100644 elisp/emms-volume-amixer.el create mode 100644 elisp/emms-volume-mixerctl.el create mode 100644 elisp/emms-volume-pulse.el create mode 100644 elisp/emms-volume-sndioctl.el create mode 100644 elisp/emms-volume.el create mode 100644 elisp/emms.el diff --git a/bookmarks b/bookmarks index bd7c59b..30460aa 100644 --- a/bookmarks +++ b/bookmarks @@ -2,7 +2,12 @@ ;;; This format is meant to be slightly human-readable; ;;; nevertheless, you probably don't want to edit it. ;;; -*- End Of Bookmark File Format Version Stamp -*- -(("School" +(("org-capture-last-stored" + (filename . "~/Notes/Org-Roam/journal.org") + (front-context-string . "**** [2023-10-08") + (rear-context-string . "23-10-08 Sunday\n") + (position . 1816)) +("School" (filename . "~/Documents/School/") (front-context-string . "APUSH.pdf\n -rw-") (rear-context-string . "08 Aug 22 05:26 ") diff --git a/elisp/emms-bookmarks.el b/elisp/emms-bookmarks.el new file mode 100644 index 0000000..1c43e2a --- /dev/null +++ b/elisp/emms-bookmarks.el @@ -0,0 +1,153 @@ +;;; emms-bookmarks.el --- Bookmarks for Emms. -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin +;; Keywords: emms, bookmark + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; You can use this to add ``temporal bookmarks'' (term by Lucas +;; Bonnet) to your media files. The interesting functions here are +;; `emms-bookmarks-next', `emms-bookmarks-prev', `emms-bookmarks-add' +;; (which pauses the player while you describe the bookmark) and +;; `emms-bookmarks-clear'. All of which do exactly what you think +;; they do. + +;;; Code: + + +;; dependencies +(require 'emms) +(require 'emms-playing-time) + +(defvar emms-bookmarks-prev-overshoot 5 + "Time in seconds for skipping a previous bookmark.") + +(defun emms-bookmarks-reset (track) + "Remove all the bookmarks from TRACK." + (emms-track-set track 'bookmarks nil)) + +(defun emms-bookmarks-straight-insertion-sort (item l acc) + "Insert ITEM into the already sorted L, ACC should be nil." + (if (null l) + (append acc (list item)) + (cond ((< (cdr item) (cdr (car l))) (append acc (list item (car l)) (cdr l))) + (t (emms-bookmarks-straight-insertion-sort item (cdr l) (append acc (list (car l)))))))) + +(defun emms-bookmarks-get (track) + "Return the bookmark property from TRACK." + (emms-track-get track 'bookmarks)) + +(defun emms-bookmarks-set (track desc time) + "Set bookmark property for TRACK, text DESC at TIME seconds." + (let ((old-bookmarks (emms-track-get track 'bookmarks)) + (new-bookmarks nil)) + (setq new-bookmarks (emms-bookmarks-straight-insertion-sort (cons desc time) old-bookmarks nil)) + (emms-track-set track 'bookmarks new-bookmarks))) + +(defun emms-bookmarks-set-current (desc) + "Set bookmark property for the current track with text DESC." + (emms-bookmarks-set (emms-playlist-current-selected-track) desc emms-playing-time)) + +(defun emms-bookmarks-search (time track test) + "Return a bookmark based on heuristics. + +TIME should be a reference point in seconds. +TRACK should be an Emms track. +TEST should be a numerical comparator predicate." + (let ((s (append (list (cons "time" time)) (copy-sequence (emms-bookmarks-get track))))) + (sort s #'(lambda (a b) (funcall test (cdr a) (cdr b)))) + (while (not (= time (cdar s))) + (setq s (cdr s))) + (when (cdr s) + (car (cdr s))))) + +(defun emms-bookmarks-next-1 (time track) + "Return the bookmark after TIME for TRACK, otherwise return nil." + (emms-bookmarks-search time track #'<)) + +(defun emms-bookmarks-prev-1 (time track) + "Return the bookmark before TIME for TRACK, otherwise return nil." + (emms-bookmarks-search (- time emms-bookmarks-prev-overshoot) track #'>)) + +(defun emms-bookmarks-goto (search-f track failure-message) + "Seek the player to a bookmark. + +SEARCH-F should be a function which returns a bookmark. +TRACK should be an Emms track. +FAILURE-MESSAGE should be a string." + ;; note that when emms is paused then `emms-player-playing-p' => t + (when (not emms-player-playing-p) + (emms-start)) + (let ((m (funcall search-f emms-playing-time track))) + (if m + (progn + (emms-player-seek-to (cdr m)) + (message "%s" (car m))) + (message "%s" failure-message)))) + + +;; entry points + +(defun emms-bookmarks-next () + "Seek to the next bookmark in the current track." + (interactive) + (emms-bookmarks-goto #'emms-bookmarks-next-1 + (emms-playlist-current-selected-track) + "No next bookmark")) + +(defun emms-bookmarks-prev () + "Seek to the previous bookmark in the current track." + (interactive) + (emms-bookmarks-goto #'emms-bookmarks-prev-1 + (emms-playlist-current-selected-track) + "No previous bookmark")) + +(defmacro emms-bookmarks-with-paused-player (&rest body) + "Eval BODY with player paused." + `(progn + (when (not emms-player-paused-p) (emms-pause)) + ,@body + (when emms-player-paused-p (emms-pause)))) + +;; can't use `interactive' to promt the user here because we want to +;; pause the player before the prompt appears. +(defun emms-bookmarks-add () + "Add a new bookmark to the current track. + +This function pauses the player while prompting the user for a +description of the bookmark. The function resumes the player +after the prompt." + (interactive) + (emms-bookmarks-with-paused-player + (let ((desc (read-string "Description: "))) + (if (emms-playlist-current-selected-track) + (emms-bookmarks-set-current desc) + (error "No current track to bookmark"))))) + +(defun emms-bookmarks-clear () + "Remove all the bookmarks from the current track." + (interactive) + (let ((this (emms-playlist-current-selected-track))) + (when this (emms-bookmarks-reset this)))) + +(provide 'emms-bookmarks) + +;;; emms-bookmarks.el ends here diff --git a/elisp/emms-browser.el b/elisp/emms-browser.el new file mode 100644 index 0000000..cefa91b --- /dev/null +++ b/elisp/emms-browser.el @@ -0,0 +1,2191 @@ +;;; emms-browser.el --- a track browser supporting covers and filtering -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2023 Free Software Foundation, Inc. + +;; Author: Damien Elmes +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This code allows you to browse the metadata cache and add tracks to +;; your playlist. To be properly useful, you should M-x +;; emms-add-directory-tree to all the files you own at least once so +;; that the cache is fully populated. + +;; Usage +;; ------------------------------------------------------------------- + +;; To use, run (emms-all) and then bind `emms-smart-browse' to a key, +;; like: + +;; (global-set-key (kbd "") 'emms-smart-browse) + +;; The 'smart browsing' code attempts to link the browser and playlist +;; windows together, so that closing one will close both. Activating +;; it will toggle between three states: + +;; a) both windows displayed, with the browser focused +;; b) focus switched to the playlist window +;; c) the extra window closed, and both buffers buried + +;; If you just want access to the browser, try M-x +;; emms-browse-by-TYPE, where TYPE is one of artist, album, composer, +;; genre or year. These commands can also be used while smart browsing to +;; change the browsing category. + +;; If you don't want to activate the code with (emms-devel), you can +;; activate it manually with: + +;; (require 'emms-browser) + +;; Displaying covers +;; ------------------------------------------------------------------- + +;; The browser will attempt to display cover images if they're +;; available. By default it looks for images cover_small.jpg, +;; cover_med.jpg, etc. Customize emms-browser-covers to use your own +;; covers. Note that you'll probably want to resize your existing +;; covers to particular sizes. Suggested sizes are 100x100 for small, +;; and 200x200 for medium. + +;; Also emacs by default will jump around a lot when scrolling a +;; buffer with images. Set the following variables to prevent that: + +;; scroll-up-aggressively 0.0 +;; scroll-down-aggressively 0.0 + +;; To show a 'no cover' image for albums which don't have a cover, add +;; the following code to your .emacs: + +;; (setq emms-browser-default-covers +;; (list "/path/to/cover_small.jpg" nil nil) + +;; (the medium and large images can be set too, if you want) + +;; You can download an example 'no cover' image from: +;; http://repose.cx/cover_small.jpg + +;; Filtering tracks +;; ------------------------------------------------------------------- + +;; If you want to display a subset of your collection (such as a +;; directory of 80s music, only avi files, etc), then you can make +;; some filters using code like this: + +;; ;; show everything +;; (emms-browser-make-filter "all" 'ignore) + +;; ;; Set "all" as the default filter +;; (emms-browser-set-filter (assoc "all" emms-browser-filters)) + +;; ;; show all files (no streamlists, etc) +;; (emms-browser-make-filter +;; "all-files" (emms-browser-filter-only-type 'file)) + +;; ;; show only tracks in one folder +;; (emms-browser-make-filter +;; "80s" (emms-browser-filter-only-dir "~/Mp3s/80s")) + +;; ;; show all tracks played in the last month +;; (emms-browser-make-filter +;; "last-month" (emms-browser-filter-only-recent 30)) + +;; After executing the above commands, you can use M-x +;; emms-browser-show-all, emms-browser-show-80s, etc to toggle +;; between different collections. Alternatively you can use '<' and +;; '>' to cycle through the available filters. + +;; The second argument to make-filter is a function which returns t if +;; a single track should be filtered. You can write your own filter +;; functions to check the type of a file, etc. + +;; Some more examples: + +;; ;; show only tracks not played in the last year +;; (emms-browser-make-filter "not-played" +;; (lambda (track) +;; (not (funcall (emms-browser-filter-only-recent 365) track)))) + +;; ;; show all files that are not in the pending directory +;; (emms-browser-make-filter +;; "all" +;; (lambda (track) +;; (or +;; (funcall (emms-browser-filter-only-type 'file) track) +;; (not (funcall +;; (emms-browser-filter-only-dir "~/Media/pending") track))))) + +;; Changing tree structure +;; ------------------------------------------------------------------- + +;; You can change the way the tree is displayed by modifying +;; `emms-browser-next-mapping-type'. The following code displays +;; artist->track instead of artist->album->track when you switch to +;; the 'singles' filter. + +;; (advice-add 'emms-browser-next-mapping-type :around #'my-emms--types) +;; (defun my-emms--types (orig-fun &rest args) +;; (let ((type (apply orig-fun args))) +;; (if (eq type 'info-album) +;; 'info-title) +;; type))) + +;; (defun toggle-album-display () +;; (if (string= emms-browser-current-filter-name "singles") +;; (ad-activate 'emms-browser-next-mapping-type) +;; (ad-deactivate 'emms-browser-next-mapping-type))) + +;; (add-hook 'emms-browser-filter-changed-hook 'toggle-album-display) + +;; Changing display format +;; ------------------------------------------------------------------- + +;; Format strings govern the way items are displayed in the browser +;; and playlist. You can customize these if you wish. + +;; `emms-browser-default-format' controls the format to use when no +;; other format has been explicitly defined. By default, only track and +;; albums deviate from the default. + +;; To customise the format of a particular type, find the name of the +;; field you want to use (eg `info-artist', `info-title', etc), and +;; insert that into emms-browser--format or +;; emms-browser-playlist--format. For example, if you wanted to +;; remove track numbers from tracks in both the browser and playlist, +;; you could do: + +;; (defvar emms-browser-info-title-format "%i%n") +;; (defvar emms-browser-playlist-info-title-format +;; emms-browser-info-title-format) + +;; The format specifiers available include: + +;; %i indent relative to the current level +;; %n the value of the item - eg -info-artist might be "pink floyd" +;; %y the album year +;; %A the album name +;; %a the artist name of the track +;; %C the composer name of the track +;; %p the performer name of the track +;; %t the title of the track +;; %T the track number +;; %cS a small album cover +;; %cM a medium album cover +;; %cL a big album cover + +;; Note that if you use track-related items like %t, it will take the +;; data from the first track. + +;; Changing display faces +;; ------------------------------------------------------------------- + +;; The faces used to display the various fields are also customizable. +;; They are in the format emms-browser--face, where type is one +;; of "year/genre", "artist", "composer", "performer", "album" or +;; "track". Note that faces lack the initial "info-" part. For example, +;; to change the artist face, type +;; M-x customize-face emms-browser-artist-face. + +;; Deleting files +;; ------------------------------------------------------------------- + +;; You can use the browser to delete tracks from your hard disk. +;; Because this is dangerous, it is disabled by default. + +;; The following code will delete covers at the same time, and remove +;; parent directories if they're now empty. + +;; (defun de-kill-covers-and-parents (dir tracks) +;; (when (> (length tracks) 1) +;; ;; if we're not deleting an individual file, delete covers too +;; (dolist (cover '("cover.jpg" +;; "cover_med.jpg" +;; "cover_small.jpg" +;; "folder.jpg")) +;; (condition-case nil +;; (delete-file (concat dir cover)) +;; (error nil))) +;; ;; try and delete empty parents - we actually do the work of the +;; ;; calling function here, too +;; (let (failed) +;; (while (and (not (string= dir "/")) +;; (not failed)) +;; (condition-case nil +;; (delete-directory dir) +;; (error (setq failed t))) +;; (setq dir (file-name-directory (directory-file-name dir))))))) +;; (add-hook 'emms-browser-delete-files-hook 'de-kill-covers-and-parents) + +;;; Code: + +(require 'cl-lib) +(require 'emms) +(require 'emms-cache) +(require 'emms-volume) +(require 'emms-source-file) +(require 'emms-playlist-sort) +(require 'sort) +(require 'seq) + + +;; -------------------------------------------------- +;; Variables and configuration +;; -------------------------------------------------- + +(defvar emms-browser-mode-hook nil + "Emms browser mode hook.") + +(defgroup emms-browser nil + "*The Emacs Multimedia System browser" + :prefix "emms-browser-" + :group 'multimedia + :group 'applications) + +(defcustom emms-browser-default-browse-type + 'info-artist + "The default browsing mode." + :type 'function) + +(defcustom emms-browser-get-track-field-function + #'emms-browser-get-track-field-albumartist + "A function to get an element from a track. +Change this to customize the way data is organized in the +browser. For example, +`emms-browser-get-track-field-use-directory-name' uses the +directory name to determine the artist. This means that +soundtracks, compilations and so on don't populate the artist +view with lots of 1-track elements." + :type '(choice (function :tag "Sort by album-artist" emms-browser-get-track-field-albumartist) + (function :tag "Simple" emms-browser-get-track-field-simple))) + +(defcustom emms-browser-covers + '("cover_small" "cover_med" "cover_large") + "Control how cover images are found. +Can be either a list of small, medium and large images (large +currently not used), a function which takes a directory and one +of the symbols `small', `medium' or `large', and should return a +path to the cover, or nil to turn off cover loading." + :type '(choice list function boolean)) + +(defcustom emms-browser-covers-file-extensions + '("jpg" "jpeg" "png" "gif" "bmp") + "File extensions accepted for `emms-browser-covers'. +Should be a list of extensions as strings. Should be set before +emms-browser is required." + :type '(repeat (string :tag "Extension"))) + +(defconst emms-browser--covers-filename nil + "*List of potential cover art names.") + +(defcustom emms-browser-default-covers nil + "A list of default images to use if a cover isn't found." + :type 'list) + +(defcustom emms-browser-comparison-test + (if (fboundp 'define-hash-table-test) + 'case-fold + 'equal) + "A method for comparing entries in the cache. +The default is to compare case-insensitively." + :type 'symbol) + +(defcustom emms-browser-track-sort-function + #'emms-sort-natural-order-less-p + "How to sort tracks in the browser. +Ues nil for no sorting." + :type 'function) + +(defcustom emms-browser-alpha-sort-function + (if (functionp 'string-collate-lessp) #'string-collate-lessp #'string<) + "How to sort artists/albums/etc. in the browser. +Use nil for no sorting." + :type 'function) + +(defcustom emms-browser-album-sort-function + #'emms-browser-sort-by-year-or-name + "How to sort artists/albums/etc. in the browser. +Use nil for no sorting." + :type 'function) + +(defcustom emms-browser-show-display-hook nil + "Hooks to run when starting or switching to a browser buffer." + :type 'hook) + +(defcustom emms-browser-hide-display-hook nil + "Hooks to run when burying or removing a browser buffer." + :type 'hook) + +(defcustom emms-browser-tracks-added-hook nil + "Hooks to run when tracks are added to the playlist." + :type 'hook) + +(defcustom emms-browser-filter-tracks-hook nil + "Given a track, return t if the track should be ignored." + :type 'hook) + +(defcustom emms-browser-filter-changed-hook nil + "Hook run after the filter has changed." + :type 'hook) + +(defcustom emms-browser-delete-files-hook nil + "Hook run after files have been deleted. +This hook can be used to clean up extra files, such as album covers. +Called once for each directory." + :type 'hook) + +(defvar emms-browser-buffer nil + "The current browser buffer, if any.") + +(defvar emms-browser-buffer-name "*EMMS Browser*" + "The default buffer name.") + +(defvar emms-browser-search-buffer-name "*emms-browser-search*" + "The search buffer name.") + +(defvar emms-browser-top-level-hash nil + "The current mapping db, eg. artist -> track.") +(make-variable-buffer-local 'emms-browser-top-level-hash) + +(defvar emms-browser-top-level-type nil + "The current mapping type, eg. \\='info-artist.") +(make-variable-buffer-local 'emms-browser-top-level-type) + +(defvar emms-browser-current-indent nil + "Used to override the current indent, for the playlist, etc.") + +(defvar emms-browser-current-filter-name nil + "The name of the current filter in place, if any.") + +(defvar emms-browser-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "q") #'emms-browser-bury-buffer) + (define-key map (kbd "/") #'emms-isearch-buffer) + (define-key map (kbd "r") #'emms-browser-goto-random) + (define-key map (kbd "n") #'next-line) + (define-key map (kbd "p") #'previous-line) + (define-key map (kbd "C") #'emms-browser-clear-playlist) + (define-key map (kbd "?") #'describe-mode) + (define-key map (kbd "C-/") #'emms-playlist-mode-undo) + (define-key map (kbd "SPC") #'emms-browser-toggle-subitems) + (define-key map (kbd "^") #'emms-browser-move-up-level) + (define-key map (kbd "RET") #'emms-browser-add-tracks) + (define-key map (kbd "") #'emms-browser-add-tracks-and-play) + (define-key map (kbd "C-j") #'emms-browser-add-tracks-and-play) + (define-key map (kbd "") #'emms-browser-toggle-subitems) + (define-key map (kbd "") #'emms-browser-prev-non-track) + (define-key map (kbd "d") #'emms-browser-view-in-dired) + (define-key map (kbd "D") #'emms-browser-delete-files) + (define-key map (kbd "E") #'emms-browser-expand-all) + (define-key map (kbd "1") #'emms-browser-collapse-all) + (define-key map (kbd "2") #'emms-browser-expand-to-level-2) + (define-key map (kbd "3") #'emms-browser-expand-to-level-3) + (define-key map (kbd "4") #'emms-browser-expand-to-level-4) + (define-key map (kbd "b 1") #'emms-browse-by-artist) + (define-key map (kbd "b 2") #'emms-browse-by-album) + (define-key map (kbd "b 3") #'emms-browse-by-genre) + (define-key map (kbd "b 4") #'emms-browse-by-year) + (define-key map (kbd "b 5") #'emms-browse-by-composer) + (define-key map (kbd "b 6") #'emms-browse-by-performer) + (define-key map (kbd "s a") #'emms-browser-search-by-artist) + (define-key map (kbd "s c") #'emms-browser-search-by-composer) + (define-key map (kbd "s p") #'emms-browser-search-by-performer) + (define-key map (kbd "s A") #'emms-browser-search-by-album) + (define-key map (kbd "s t") #'emms-browser-search-by-title) + (define-key map (kbd "s s") #'emms-browser-search-by-names) + (define-key map (kbd "W A w") #'emms-browser-lookup-artist-on-wikipedia) + (define-key map (kbd "W C w") #'emms-browser-lookup-composer-on-wikipedia) + (define-key map (kbd "W P w") #'emms-browser-lookup-performer-on-wikipedia) + (define-key map (kbd "W a w") #'emms-browser-lookup-album-on-wikipedia) + (define-key map (kbd ">") #'emms-browser-next-filter) + (define-key map (kbd "<") #'emms-browser-previous-filter) + (define-key map (kbd "+") #'emms-volume-raise) + (define-key map (kbd "-") #'emms-volume-lower) + map) + "Keymap for `emms-browser-mode'.") + +(defvar emms-browser-search-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map emms-browser-mode-map) + (define-key map (kbd "q") #'emms-browser-kill-search) + map) + "Keymap for `emms-browser-mode'.") + +;; -------------------------------------------------- +;; Compatability functions +;; -------------------------------------------------- + +(eval-and-compile + (if (fboundp 'with-selected-window) ;Emacs-22 + (defalias 'emms-browser-with-selected-window #'with-selected-window) + (defmacro emms-browser-with-selected-window (window &rest body) + (ignore window) + ;; this emulates the behavior introduced earlier, though it + ;; might be best to do something with `window' + `(save-selected-window ,body))) + (put 'emms-browser-with-selected-window 'lisp-indent-function 1) + (put 'emms-browser-with-selected-window 'edebug-form-spec '(form body))) + +(defalias 'emms-browser-run-mode-hooks + (if (fboundp 'run-mode-hooks) ;Emacs-22 + #'run-mode-hooks + #'run-hooks)) + +;; -------------------------------------------------- +;; General mode setup +;; -------------------------------------------------- + +;;;###autoload +(defun emms-browser () + "Launch or switch to the EMMS Browser." + (interactive) + (emms-browser-create-or-focus + emms-browser-default-browse-type)) + +(defun emms-browser-create-or-focus (type) + "Create a new browser buffer with BROWSE-FUNC, or switch. +BROWSE-FUNC should fill the buffer with something of interest. An +example function is `emms-browse-by-artist'." + (let ((buf (emms-browser-get-buffer)) + wind) + (if buf + ;; if the buffer is displayed, switch the window instead + (progn + (setq wind (get-buffer-window buf)) + (if wind + (select-window wind) + (switch-to-buffer buf)) + (emms-browser-run-mode-hooks 'emms-browser-show-display-hook)) + ;; if there's no buffer, create a new window + (emms-browser-create) + (emms-browse-by type)))) + +(defun emms-browser-create () + "Create a new emms-browser buffer and start emms-browser-mode." + (emms-browser-new-buffer) + (emms-browser-mode) + (emms-browser-run-mode-hooks 'emms-browser-show-display-hook)) + +(defun emms-browser-mode (&optional no-update) + "A major mode for the Emms browser. +\\{emms-browser-mode-map}" + ;; create a new buffer + (interactive) + + (use-local-map emms-browser-mode-map) + (setq major-mode 'emms-browser-mode + mode-name "Emms-Browser") + + (setq buffer-read-only t) + (unless no-update + (setq emms-browser-buffer (current-buffer))) + + (run-hooks 'emms-browser-mode-hook)) + +(defun emms-browser-new-buffer () + "Create a new browser buffer, and switch to it." + (switch-to-buffer (generate-new-buffer + emms-browser-buffer-name))) + +(defun emms-browser-clear () + "Create or switch to a browser buffer, clearing it." + (let ((buf (emms-browser-get-buffer))) + (if buf + (progn + (switch-to-buffer buf) + (emms-with-inhibit-read-only-t + (delete-region (point-min) (point-max)))) + (emms-browser-create)))) + +(defun emms-browser-get-buffer () + "Return the current buffer if it exists, or nil. +If a browser search exists, return it." + (or (get-buffer emms-browser-search-buffer-name) + (unless (or (null emms-browser-buffer) + (not (buffer-live-p emms-browser-buffer))) + emms-browser-buffer))) + +(defun emms-browser-ensure-browser-buffer () + (unless (eq major-mode 'emms-browser-mode) + (error "Current buffer is not an emms-browser buffer"))) + +(defun emms-browser-bury-buffer () + "Bury the browser buffer, running hooks." + (interactive) + (emms-browser-run-mode-hooks 'emms-browser-hide-display-hook) + (bury-buffer)) + +;; -------------------------------------------------- +;; Top-level browsing methods - by artist/album/etc +;; -------------------------------------------------- + +;; Since the number of tracks may be rather large, we use a hash to +;; sort the top level elements into various categories. All +;; subelements will be stored in a bdata alist structure. + +(defmacro emms-browser-add-category (name type) + "Create an interactive function emms-browse-by-NAME." + (let ((funname (intern (concat "emms-browse-by-" name))) + (funcdesc (concat "Browse by " name "."))) + `(defun ,funname () + ,funcdesc + (interactive) + (emms-browse-by ,type)))) + +(defun emms-browse-by (type) + "Render a top level buffer based on TYPE." + ;; FIXME: assumes we only browse by info-* + (let* ((name (substring (symbol-name type) 5)) + (modedesc (concat "Browsing by: " name)) + (hash (emms-browser-make-hash-by type))) + (when emms-browser-current-filter-name + (setq modedesc (concat modedesc + " [" emms-browser-current-filter-name "]"))) + (emms-browser-clear) + (rename-buffer modedesc) + (emms-browser-render-hash hash type) + (setq emms-browser-top-level-hash hash) + (setq emms-browser-top-level-type type) + (unless (> (hash-table-count hash) 0) + (emms-browser-show-empty-cache-message)) + (goto-char (point-min)))) + +(emms-browser-add-category "artist" 'info-artist) +(emms-browser-add-category "composer" 'info-composer) +(emms-browser-add-category "performer" 'info-performer) +(emms-browser-add-category "album" 'info-album) +(emms-browser-add-category "genre" 'info-genre) +(emms-browser-add-category "year" 'info-year) + +(defun emms-browser-get-track-field (track type) + "Return TYPE from TRACK. +This can be customized to group different artists into one for +compilations, etc." + (funcall emms-browser-get-track-field-function track type)) + +(defun emms-browser-get-track-field-simple (track type) + "Return TYPE from TRACK without any heuristic. +This function can be used as +`emms-browser-get-track-field-function'." + (emms-track-get track type "misc")) + +(defun emms-browser-get-track-field-albumartist (track type) + "Return TYPE from TRACK with an albumartist-oriented heuristic. +For \\='info-artist TYPE, use \\='info-albumartistsort, +\\='info-albumartist, \\='info-artistsort. +For \\='info-year TYPE, use \\='info-originalyear, \\='info-originaldate and +\\='info-date symbols." + (cond ((eq type 'info-artist) + (or (emms-track-get track 'info-albumartist) + (emms-track-get track 'info-albumartistsort) + (emms-track-get track 'info-artist) + (emms-track-get track 'info-artistsort ""))) + ((eq type 'info-year) + (let ((date (or (emms-track-get track 'info-originaldate) + (emms-track-get track 'info-originalyear) + (emms-track-get track 'info-date) + (emms-track-get track 'info-year "")))) + (emms-format-date-to-year date))) + (t (emms-track-get track type "misc")))) + +(defun emms-browser-get-track-field-use-directory-name (track type) + (if (eq type 'info-artist) + (emms-browser-get-artist-from-path + track) + (emms-track-get track type "misc"))) + +(defun emms-browser-get-artist-from-path (track) + (let* ((path (emms-track-get track 'name)) + (dir (file-name-directory path)) + (basedir + (file-name-nondirectory + (directory-file-name + (file-name-directory dir))))) + (car (split-string basedir " - ")))) + +(defun emms-browser-make-hash-by (type) + "Make a hash, mapping with TYPE, eg artist -> tracks." + (let ((hash (make-hash-table + :test emms-browser-comparison-test)) + field existing-entry) + (maphash (lambda (_path track) + (unless (run-hook-with-args-until-success + 'emms-browser-filter-tracks-hook track) + (setq field + (emms-browser-get-track-field track type)) + (when field + (setq existing-entry (gethash field hash)) + (if existing-entry + (puthash field (cons track existing-entry) hash) + (puthash field (list track) hash))))) + emms-cache-db) + hash)) + +(defun emms-browser-render-hash (db type) + "Render a mapping (DB) into a browser buffer." + (maphash (lambda (desc data) + (emms-browser-insert-top-level-entry desc data type)) + db) + (emms-with-inhibit-read-only-t + (let ((sort-fold-case t)) + (if emms-browser-alpha-sort-function + (progn + (goto-char (point-min)) + (sort-subr nil + #'forward-line #'end-of-line + (lambda () (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) + nil + emms-browser-alpha-sort-function)) + (sort-lines nil (point-min) (point-max)))))) + +(defun case-fold-string= (a b) + (eq t (compare-strings a nil nil b nil nil t))) + +(defun case-fold-string-hash (a) + (sxhash (upcase a))) + +(when (fboundp 'define-hash-table-test) + (define-hash-table-test 'case-fold + 'case-fold-string= 'case-fold-string-hash)) + +(defun emms-browser-insert-top-level-entry (name tracks type) + "Insert a single top level entry into the buffer." + (emms-browser-ensure-browser-buffer) + (let ((bdata (emms-browser-make-bdata-tree type 1 tracks name))) + (emms-browser-insert-format bdata))) + +(defun emms-browser-show-empty-cache-message () + "Display some help if the cache is empty." + (emms-with-inhibit-read-only-t + (insert " +Welcome to EMMS. + +There are currently no files in the EMMS database. +To browse music, you need to tell EMMS where your +files are. + +Try the following commands: + + M-x emms-add-directory-tree: + Add all music in a directory and its subdirectories. + + M-x emms-add-directory: + Add all music in a directory + + M-x emms-add-file: Add a single music file. + +After you have added some files, wait for EMMS to say +'all track information loaded,' then return to the +browser, and hit 'b 1' to refresh."))) + +;; -------------------------------------------------- +;; Building a subitem tree +;; -------------------------------------------------- + +(defun emms-browser-next-mapping-type (current-mapping) + "Return the next sensible mapping. +Eg. if CURRENT-MAPPING is currently \\='info-artist, return + \\='info-album." + (cond + ((eq current-mapping 'info-artist) 'info-album) + ((eq current-mapping 'info-composer) 'info-album) + ((eq current-mapping 'info-performer) 'info-album) + ((eq current-mapping 'info-album) 'info-title) + ((eq current-mapping 'info-genre) 'info-artist) + ((eq current-mapping 'info-year) 'info-artist))) + +(defun emms-browser-make-bdata-tree (type level tracks name) + "Build a tree of browser DB elements for tracks." + (emms-browser-make-bdata + (emms-browser-make-bdata-tree-recurse + type level tracks) + name + type level)) + +(defun emms-browser-make-bdata-tree-recurse (type level tracks) + "Build a tree of alists based on a list of tracks, TRACKS. +For example, if TYPE is \\='info-year, return an alist like: +artist1 -> album1 -> *track* 1.." + (let* ((next-type (emms-browser-next-mapping-type type)) + (next-level (1+ level)) + alist name _new-db new-tracks) + ;; if we're at a leaf, the db data is a list of tracks + (if (eq type 'info-title) + tracks + ;; otherwise, make DBs from the sub elements + (setq alist + (emms-browser-make-sorted-alist + next-type tracks)) + (mapcar (lambda (entry) + (setq name (emms-browser-make-name + entry next-type)) + (setq new-tracks (cdr entry)) + (emms-browser-make-bdata + (emms-browser-make-bdata-tree-recurse + next-type next-level new-tracks) + name next-type next-level)) + alist)))) + +(defun emms-browser-make-name (entry type) + "Return a name for ENTRY, used for making a bdata object." + (let ((key (car entry)) + (track (cadr entry)) + artist title) ;; only the first track + (cond + ((eq type 'info-title) + (setq artist (emms-track-get track 'info-artist)) + (setq title (emms-track-get track 'info-title)) + (if (not (and artist title)) + key + (concat artist " - " title))) + (t key)))) + +(defun emms-browser-track-number (track) + "Return a string representation of a track number. +The string will end in a space. If no track number is available, +return an empty string." + (let ((tracknum (emms-track-get track 'info-tracknumber))) + (if (or (not (stringp tracknum)) (string= tracknum "0")) + "" + (concat + (if (eq (length tracknum) 1) + (concat "0" tracknum) + tracknum))))) + +(defun emms-browser-disc-number (track) + "Return a string representation of a track number. +The string will end in a space. If no track number is available, +return an empty string." + (let ((discnum (emms-track-get track 'info-discnumber))) + (if (or (not (stringp discnum)) (string= discnum "0")) + "" + discnum))) + +(defun emms-browser-year-number (track) + "Return a string representation of a track\\='s year. +This will be in the form \\='(1998) \\='." + (let ((year (emms-track-get-year track))) + (if (or (not (stringp year)) (string= year "0")) + "" + (concat + "(" year ") ")))) + +(defun emms-browser-track-duration (track) + "Return a string representation of a track duration. +If no duration is available, return an empty string." + (let ((pmin (emms-track-get track 'info-playing-time-min)) + (psec (emms-track-get track 'info-playing-time-sec)) + (ptot (emms-track-get track 'info-playing-time))) + (cond ((and pmin psec) (format "%02d:%02d" pmin psec)) + (ptot (format "%02d:%02d" (/ ptot 60) (% ptot 60))) + (t "")))) + +(defun emms-browser-make-bdata (data name type level) + "Return a browser data item from ALIST. +DATA should be a list of DB items, or a list of tracks. +NAME is a name for the DB item. +TYPE is a category the data is organised by, such as \\='info-artist. +LEVEL is the number of the sublevel the db item will be placed in." + (list (cons 'type type) + (cons 'level level) + (cons 'name name) + (cons 'data data))) + +(defun emms-browser-make-alist (type tracks) + "Make an alist mapping of TYPE -> TRACKS. +Items with no metadata for TYPE will be placed in \\='misc\\='" + (let (db key existing tracknum) + (dolist (track tracks) + (setq key (emms-browser-get-track-field track type)) + (when (eq type 'info-title) + ;; try and make every track unique + (setq tracknum (emms-browser-track-number track)) + (if (string= tracknum "") + (setq key (file-name-nondirectory + (emms-track-get track 'name))) + (setq key (concat tracknum key)))) + (setq existing (assoc key db)) + (if existing + (setcdr existing (cons track (cdr existing))) + (push (cons key (list track)) db))) + ;; sort the entries we've built + (dolist (item db) + (setcdr item (nreverse (cdr item)))) + db)) + +(defun emms-browser-make-sorted-alist (type tracks) + "Return a sorted alist of TRACKS. +TYPE is the metadata to make the alist by - eg. if it\\='s +\\='info-artist, an alist of artists will be made." + (emms-browser-sort-alist + (emms-browser-make-alist type tracks) + type)) + +;; -------------------------------------------------- +;; BDATA accessors and predicates +;; -------------------------------------------------- + +(defun emms-browser-bdata-level (bdata) + (cdr (assq 'level bdata))) + +(defun emms-browser-bdata-name (bdata) + (cdr (assq 'name bdata))) + +(defun emms-browser-bdata-type (bdata) + (cdr (assq 'type bdata))) + +(defun emms-browser-bdata-data (bdata) + (cdr (assq 'data bdata))) + +(defun emms-browser-bdata-p (obj) + "True if obj is a BDATA object." + (consp (assq 'data obj))) + +;; -------------------------------------------------- +;; Sorting expanded entries +;; -------------------------------------------------- + +(defmacro emms-browser-sort-cadr (sort-func) + "Return a function to sort an alist using SORT-FUNC. +This sorting predicate will compare the cadr of each entry. +SORT-FUNC should be a playlist sorting predicate like +`emms-playlist-sort-by-natural-order'." + (declare (debug t)) + `(lambda (a b) + (funcall ,sort-func (cadr a) (cadr b)))) + +(defmacro emms-browser-sort-car (sort-func) + "Return a function to sort an alist using SORT-FUNC. +This sorting predicate will compare the car of each entry. +SORT-FUNC should be a playlist sorting predicate like +`emms-playlist-sort-by-natural-order'." + (declare (debug t)) + `(lambda (a b) + (funcall ,sort-func (car a) (car b)))) + +(defun emms-browser-sort-by-track (alist) + "Sort an ALIST by the tracks in each entry. +Uses `emms-browser-track-sort-function'." + (if emms-browser-track-sort-function + (sort alist (emms-browser-sort-cadr + emms-browser-track-sort-function)) + alist)) + +(defun emms-browser-sort-by-name (alist) + "Sort ALIST by keys alphabetically. +Uses `emms-browser-alpha-sort-function'." + (if emms-browser-alpha-sort-function + (sort alist (emms-browser-sort-car + emms-browser-alpha-sort-function)) + alist)) + +(defun emms-browser-sort-by-year-or-name (alist) + "Sort based on year or name." + (sort alist (emms-browser-sort-cadr + 'emms-browser-sort-by-year-or-name-p))) + +(defun emms-browser-sort-by-year-or-name-p (a b) + ;; FIXME: this is a bit of a hack + (let ((a-desc (concat + (emms-browser-year-number a) + (emms-track-get a 'info-album "misc"))) + (b-desc (concat + (emms-browser-year-number b) + (emms-track-get b 'info-album "misc")))) + (string< a-desc b-desc))) + +(defun emms-browser-sort-alist (alist type) + "Sort ALIST using the sorting function for TYPE." + (let ((sort-func + (cond + ((or + (eq type 'info-artist) + (eq type 'info-composer) + (eq type 'info-performer) + (eq type 'info-year) + (eq type 'info-genre)) + 'emms-browser-sort-by-name) + ((eq type 'info-album) + emms-browser-album-sort-function) + ((eq type 'info-title) + 'emms-browser-sort-by-track) + (t (message "Can't sort unknown mapping!"))))) + (funcall sort-func alist))) + +;; -------------------------------------------------- +;; Subitem operations on the buffer +;; -------------------------------------------------- + +(defun emms-browser-bdata-at-point () + "Return the bdata object at point. +Includes information at point (such as album name), and metadata." + (get-text-property (line-beginning-position) + 'emms-browser-bdata)) + +(defun emms-browser-data-at-point () + "Return the data stored under point. +This will be a list of DB items." + (emms-browser-bdata-data (emms-browser-bdata-at-point))) + +(defun emms-browser-level-at-point () + "Return the current level at point." + (emms-browser-bdata-level (emms-browser-bdata-at-point))) + +(defun emms-browser-tracks-at-point (&optional node) + "Return a list of tracks at point." + (let (tracks) + (dolist (node (if node + node + (emms-browser-data-at-point))) + (if (not (emms-browser-bdata-p node)) + (setq tracks (cons node tracks)) + (setq tracks + (append tracks + (emms-browser-tracks-at-point + (emms-browser-bdata-data node)))))) + tracks)) + +(defun emms-browser-expand-one-level () + "Expand the current line by one sublevel." + (interactive) + (let* ((data (emms-browser-data-at-point))) + (save-excursion + (forward-line 1) + (beginning-of-line) + (dolist (data-item data) + (emms-browser-insert-data-item data-item))))) + +(defun emms-browser-insert-data-item (data-item) + "Insert DATA-ITEM into the buffer. +This checks DATA-ITEM's level to determine how much to indent. +The line will have a property emms-browser-bdata storing subitem +information." + (emms-browser-insert-format data-item)) + +(defun emms-browser-find-entry-more-than-level (level) + "Move point to next entry more than LEVEL and return point. +If no entry exits, return nil. +Returns point if currently on a an entry more than LEVEL." + (let ((old-pos (point)) + level-at-point) + (forward-line 1) + (setq level-at-point (emms-browser-level-at-point)) + (if (and level-at-point + (> level-at-point level)) + (point) + (goto-char old-pos) + nil))) + +(defun emms-browser-subitems-visible () + "True if there are any subentries visible point." + (let ((current-level (emms-browser-level-at-point)) + new-level) + (save-excursion + (re-search-forward "\n" nil t) + (when (setq new-level (emms-browser-level-at-point)) + (> new-level current-level))))) + +(defun emms-browser-subitems-exist () + "True if it's possible to expand the current line." + (not (eq (emms-browser-bdata-type + (emms-browser-bdata-at-point)) + 'info-title))) + +(defun emms-browser-move-up-level (&optional direction) + "Move up one level if possible. +Return true if we were able to move up. +If DIRECTION is 1, move forward, otherwise move backwards." + (interactive "P") + (let ((moved nil) + (continue t) + (current-level (emms-browser-level-at-point))) + (while (and + continue + (zerop (forward-line + (or (and (numberp direction) direction) -1)))) + (when (> current-level (or (emms-browser-level-at-point) 0)) + (setq moved t) + (setq continue nil))) + moved)) + +(defun emms-browser-toggle-subitems () + "Show or hide (kill) subitems under the current line." + (interactive) + (if (emms-browser-subitems-visible) + (emms-browser-kill-subitems) + (if (emms-browser-subitems-exist) + (emms-browser-show-subitems) + (cl-assert (emms-browser-move-up-level)) + (emms-browser-kill-subitems)))) + +(defun emms-browser-toggle-subitems-recursively () + "Recursively toggle all subitems under the current line. +If there is no more subitems to expand, collapse the current node." + (interactive) + (let ((current-level (emms-browser-level-at-point)) + first-expandable-level) + (save-excursion + (while (or (and (emms-browser-subitems-exist) + (not (emms-browser-subitems-visible)) + (or (and (not first-expandable-level) + (setq first-expandable-level (emms-browser-level-at-point))) + (= first-expandable-level (emms-browser-level-at-point))) + (emms-browser-show-subitems)) + (emms-browser-find-entry-more-than-level current-level)))) + (unless first-expandable-level + (emms-browser-kill-subitems)))) + +(defun emms-browser-show-subitems () + "Show subitems under the current line." + (unless (emms-browser-subitems-visible) + (if (emms-browser-subitems-exist) + (emms-browser-expand-one-level)))) + +(defun emms-browser-kill-subitems () + "Remove all subitems under the current line. +Stops at the next line at the same level, or EOF." + (when (emms-browser-subitems-visible) + (let ((current-level (emms-browser-level-at-point)) + (next-line (line-beginning-position 2))) + (emms-with-inhibit-read-only-t + (delete-region next-line + (save-excursion + (while + (emms-browser-find-entry-more-than-level + current-level)) + (line-beginning-position 2))))))) + +;; -------------------------------------------------- +;; Dealing with the playlist (queuing songs, etc) +;; -------------------------------------------------- + +(defun emms-browser-playlist-insert-group (bdata) + "Insert a group description into the playlist buffer." + (let ((name (emms-browser-format-line bdata 'playlist))) + (with-current-emms-playlist + (goto-char (point-max)) + (insert name "\n")))) + +(defun emms-browser-playlist-insert-track (bdata) + "Insert a track into the playlist buffer." + (let ((name (emms-browser-format-line bdata 'playlist))) + (with-current-emms-playlist + (goto-char (point-max)) + (insert name "\n")))) + +(defun emms-browser-playlist-insert-bdata (bdata starting-level) + "Add all tracks in BDATA to the playlist." + (let ((type (emms-browser-bdata-type bdata)) + (level (emms-browser-bdata-level bdata)) + emms-browser-current-indent) + + ;; adjust the indentation relative to the starting level + (when starting-level + (setq level (- level (1- starting-level)))) + ;; we temporarily rebind the current indent to the relative indent + (setq emms-browser-current-indent + (emms-browser-make-indent level)) + + ;; add a group heading? + (unless (eq type 'info-title) + (emms-browser-playlist-insert-group bdata)) + + ;; recurse or add tracks + (dolist (item (emms-browser-bdata-data bdata)) + (if (not (eq type 'info-title)) + (emms-browser-playlist-insert-bdata item starting-level) + (emms-browser-playlist-insert-track bdata))))) + +;; -------------------------------------------------- +;; Expanding/contracting +;; -------------------------------------------------- + +(defun emms-browser-expand-to-level (level) + "Expand to a depth specified by LEVEL. +After expanding, jump to the currently marked entry." + (let ((count 1) + (total 0) + progress-reporter) + (goto-char (point-min)) + (while (not (eq (buffer-end 1) (point))) + (when (= (emms-browser-level-at-point) 1) + (setq total (1+ total))) + (emms-browser-next-non-track)) + (goto-char (point-min)) + (setq progress-reporter + (make-progress-reporter "Expanding EMMS browser entries..." + 0 total)) + (while (not (eq (buffer-end 1) (point))) + (when (= (emms-browser-level-at-point) 1) + (progress-reporter-update progress-reporter count) + (setq count (1+ count))) + (if (< (emms-browser-level-at-point) level) + (emms-browser-show-subitems)) + (emms-browser-next-non-track)) + (progress-reporter-done progress-reporter) + (emms-browser-pop-mark) + (recenter '(4)))) + +(defun emms-browser-mark-and-collapse () + "Save the current top level element, and collapse." + (emms-browser-mark-entry) + (goto-char (point-max)) + (while (not (eq (buffer-end -1) (point))) + (emms-browser-prev-non-track) + (emms-browser-kill-subitems))) + +(defun emms-browser-find-top-level () + "Move up until reaching a top-level element." + (while (not (eq (emms-browser-level-at-point) 1)) + (forward-line -1))) + +(defun emms-browser-mark-entry () + "Mark the current top level entry." + (save-excursion + (emms-browser-find-top-level) + (emms-with-inhibit-read-only-t + (add-text-properties (line-beginning-position) + (line-end-position) + (list 'emms-browser-mark t))))) + +(defun emms-browser-pop-mark () + "Return to the last marked entry, and remove the mark." + (goto-char (point-min)) + (let ((pos (text-property-any (point-min) (point-max) + 'emms-browser-mark t))) + (if pos + (progn + (goto-char pos) + (emms-with-inhibit-read-only-t + (remove-text-properties (line-beginning-position) + (line-end-position) + (list 'emms-browser-mark)))) + (message "No mark saved!")))) + +(defun emms-browser-go-to-parent () + "Move point to the parent of the current node. +Return point. If at level one, return the current point." + (let ((current-level (emms-browser-level-at-point))) + (unless (eq current-level 1) + (while (<= current-level (emms-browser-level-at-point)) + (forward-line -1))) + (point))) + +(defun emms-browser-delete-current-node () + "Remove the current node, and empty parents." + ;; set the data to empty + (setcdr (assq 'data (emms-browser-bdata-at-point)) nil) + (emms-browser-delete-node-if-empty)) + +(defun emms-browser-delete-node-if-empty () + "If empty, remove node and empty parents." + (when (zerop (length (emms-browser-data-at-point))) + (save-excursion + (let ((child-bdata (emms-browser-bdata-at-point)) + parent-bdata parent-point) + ;; record the parent's position before we delete anything + (save-excursion + (setq parent-point (emms-browser-go-to-parent))) + ;; delete the current line + (when (emms-browser-subitems-visible) + (emms-browser-kill-subitems)) + (emms-with-inhibit-read-only-t + (goto-char (line-beginning-position)) + (kill-line 1)) + (unless (eq (emms-browser-bdata-level child-bdata) 1) + ;; remove the node from the parent, and recurse + (goto-char parent-point) + (setq parent-bdata (emms-browser-bdata-at-point)) + (setcdr (assq 'data parent-bdata) + (delq child-bdata + (emms-browser-bdata-data parent-bdata))) + (emms-browser-delete-node-if-empty)))))) + +;; -------------------------------------------------- +;; User-visible commands +;; -------------------------------------------------- + +(defun emms-browser-add-tracks () + "Add all tracks at point or in region if active. +When the region is not active, a numeric prefix argument inserts that many +tracks from point. +Return the playlist buffer point-max before adding." + (interactive) + (let ((count (cond + ((use-region-p) + (1+ (- (line-number-at-pos (region-end)) (line-number-at-pos (region-beginning))))) + ((numberp current-prefix-arg) + current-prefix-arg) + (t 1))) + (first-new-track (with-current-emms-playlist (point-max)))) + (when (use-region-p) (goto-char (region-beginning))) + (dotimes (_ count first-new-track) + (let ((bdata (emms-browser-bdata-at-point))) + (when bdata + (emms-browser-playlist-insert-bdata + bdata (emms-browser-bdata-level bdata)) + (forward-line)))) + (run-hook-with-args 'emms-browser-tracks-added-hook + first-new-track) + (deactivate-mark) + first-new-track)) + +(defun emms-browser-add-tracks-and-play () + "Add all tracks at point, and play the first added track." + (interactive) + (let ((old-pos (emms-browser-add-tracks))) + (with-current-emms-playlist + (goto-char old-pos) + ;; if we're sitting on a group name, move forward + (unless (emms-playlist-track-at (point)) + (emms-playlist-next)) + (emms-playlist-select (point))) + ;; FIXME: is there a better way of doing this? + (emms-stop) + (emms-start))) + +(defun emms-isearch-buffer () + "Isearch through the buffer." + (interactive) + (goto-char (point-min)) + (when (isearch-forward) + (unless (emms-browser-subitems-visible) + (emms-browser-show-subitems)))) + +(defun emms-browser-next-non-track (&optional direction) + "Jump to the next non-track element." + (interactive) + (let ((continue t)) + (while (and continue + (forward-line (or direction 1))) + (unless (eq (emms-browser-bdata-type + (emms-browser-bdata-at-point)) 'info-title) + (setq continue nil))))) + +(defun emms-browser-prev-non-track () + "Jump to the previous non-track element." + (interactive) + (emms-browser-next-non-track -1)) + +(defun emms-browser-expand-all () + "Expand everything." + (interactive) + (emms-browser-expand-to-level 99)) + +(defun emms-browser-expand-to-level-2 () + "Expand all top level items one level." + (interactive) + (emms-browser-mark-and-collapse) + (emms-browser-expand-to-level 2)) + +(defun emms-browser-expand-to-level-3 () + "Expand all top level items two levels." + (interactive) + (emms-browser-mark-and-collapse) + (emms-browser-expand-to-level 3)) + +(defun emms-browser-expand-to-level-4 () + "Expand all top level items three levels." + (interactive) + (emms-browser-mark-and-collapse) + (emms-browser-expand-to-level 4)) + +(defun emms-browser-collapse-all () + "Collapse everything, saving and restoring the mark." + (interactive) + (emms-browser-mark-and-collapse) + (emms-browser-pop-mark) + (recenter '(4))) + +(defvar emms-browser-seed-pending t + "Do we need to seed (random)?") + +(defun emms-browser-goto-random () + "Move cursor to random item with the lowest visible level." + (interactive) + (when emms-browser-seed-pending + (random t) + (setq emms-browser-seed-pending nil)) + (while (progn (goto-char (point-min)) + (forward-line (1- (random (count-lines (point-min) (point-max))))) + (emms-browser-subitems-visible)))) + +(defun emms-browser-view-in-dired (&optional bdata) + "View the current directory in dired." + ;; FIXME: currently just grabs the directory from the first track + (interactive) + (if bdata + (if (eq (emms-browser-bdata-type bdata) 'info-title) + (let* ((track (car (emms-browser-bdata-data bdata))) + (path (emms-track-get track 'name)) + (dir (file-name-directory path))) + (find-file dir)) + (emms-browser-view-in-dired (car (emms-browser-bdata-data bdata)))) + (emms-browser-view-in-dired (emms-browser-bdata-at-point)))) + +(defun emms-browser-remove-tracks (&optional delete start end) + "Remove all tracks at point or in region if active. +Unless DELETE is non-nil or with prefix argument, this only acts on the browser, +files are untouched. +If caching is enabled, files are removed from the cache as well. +When the region is not active, a numeric prefix argument remove that many +tracks from point, it does not delete files." + (interactive "P\nr") + (let ((count (cond + ((use-region-p) + (1+ (- (line-number-at-pos end) (line-number-at-pos start)))) + ((numberp current-prefix-arg) + current-prefix-arg) + (t 1))) + dirs path tracks) + ;; If numeric prefix argument, never delete files. + (when (numberp delete) (setq delete nil)) + (when delete + (save-mark-and-excursion + (when (use-region-p) (goto-char start)) + (let ((lines (min count (- (line-number-at-pos (point-max)) (line-number-at-pos (point)))))) + (dotimes (_ lines) + ;; TODO: Test this! + (setq tracks (append tracks (emms-browser-tracks-at-point))) + (forward-line)))) + (unless (yes-or-no-p + (format "Really permanently delete these %d tracks? " (length tracks))) + (error "Cancelled!")) + (message "Deleting files...")) + (when (use-region-p) (goto-char start)) + (dotimes (_ count) + (dolist (track (emms-browser-tracks-at-point)) + (setq path (emms-track-get track 'name)) + (when delete + (delete-file path)) + (cl-pushnew (file-name-directory path) dirs) + (emms-cache-del path)) + ;; remove the item from the browser + (when (emms-browser-tracks-at-point) + (emms-browser-delete-current-node))) + (deactivate-mark) + ;; remove empty dirs + (when delete + (dolist (dir dirs) + (run-hook-with-args 'emms-browser-delete-files-hook dir tracks) + (condition-case nil + (delete-directory dir) + (error nil)))) + (when delete + (message "Deleting files...done")))) + +(defalias 'emms-browser-delete-files 'emms-browser-remove-tracks) +(put 'emms-browser-delete-files 'disabled t) + +(defun emms-browser-clear-playlist () + (interactive) + (with-current-emms-playlist + (emms-playlist-clear))) + +(defun emms-browser-lookup (field url) + (let ((data + (emms-track-get (emms-browser-bdata-first-track + (emms-browser-bdata-at-point)) + field))) + (when data + (browse-url + (concat url data))))) + +(defun emms-browser-lookup-wikipedia (field) + (emms-browser-lookup + field "http://en.wikipedia.org/wiki/Special:Search?search=")) + +(defun emms-browser-lookup-artist-on-wikipedia () + (interactive) + (emms-browser-lookup-wikipedia 'info-artist)) + +(defun emms-browser-lookup-composer-on-wikipedia () + (interactive) + (emms-browser-lookup-wikipedia 'info-composer)) + +(defun emms-browser-lookup-performer-on-wikipedia () + (interactive) + (emms-browser-lookup-wikipedia 'info-performer)) + +(defun emms-browser-lookup-album-on-wikipedia () + (interactive) + (emms-browser-lookup-wikipedia 'info-album)) + + +;; -------------------------------------------------- +;; Linked browser and playlist windows +;; -------------------------------------------------- + +(defcustom emms-browser-switch-to-playlist-on-add + nil + "Whether to switch to to the playlist after adding files." + :type 'boolean) + +;;;###autoload +(defun emms-smart-browse () + "Display browser and playlist. +Toggle between selecting browser, playlist or hiding both. Tries +to behave sanely if the user has manually changed the window +configuration." + (interactive) + (add-hook 'emms-browser-show-display-hook + #'emms-browser-display-playlist) + (add-hook 'emms-browser-hide-display-hook + #'emms-browser-hide-linked-window) + ;; switch to the playlist window when adding tracks? + (add-hook 'emms-browser-tracks-added-hook + (lambda (start-of-tracks) (interactive) + (let (playlist-window) + (when emms-browser-switch-to-playlist-on-add + (emms-smart-browse)) + ;; center on the first added track/group name + (when + (setq playlist-window + (emms-browser-get-linked-window)) + (emms-browser-with-selected-window + playlist-window + (goto-char start-of-tracks) + (recenter '(4))))))) + (let (wind) + (cond + ((eq major-mode 'emms-browser-mode) + (setq wind (emms-browser-get-linked-window)) + ;; if the playlist window is visible, select it + (if wind + (select-window wind) + ;; otherwise display and select it + (select-window (emms-browser-display-playlist)))) + ((eq major-mode 'emms-playlist-mode) + (setq wind (emms-browser-get-linked-window)) + ;; if the playlist window is selected, and the browser is visible, + ;; hide both + (if wind + (progn + (select-window wind) + (emms-browser-bury-buffer) + ;; After a browser search, the following buffer could be the + ;; unfiltered browser, which we want to bury as well. We don't want + ;; to call `emms-browser-hide-display-hook' for this one so we bury it + ;; directly. + (when (eq major-mode 'emms-browser-mode) + (bury-buffer))) + ;; otherwise bury both + (bury-buffer) + (emms-browser-hide-linked-window))) + (t + ;; show both + (emms-browser))))) + +(defun emms-browser-get-linked-buffer () + "Return linked buffer (eg browser if playlist is selected." + (cond + ((eq major-mode 'emms-browser-mode) + (car (emms-playlist-buffer-list))) + ((eq major-mode 'emms-playlist-mode) + (emms-browser-get-buffer)))) + +(defun emms-browser-get-linked-window () + "Return linked window (eg browser if playlist is selected." + (let ((buf (emms-browser-get-linked-buffer))) + (when buf + (get-buffer-window buf)))) + +(defun emms-browser-display-playlist () + "A hook to show the playlist when the browser is displayed. +Returns the playlist window." + (interactive) + (let ((pbuf (emms-browser-get-linked-buffer)) + (pwin (emms-browser-get-linked-window))) + ;; if the window isn't alive.. + (unless (window-live-p pwin) + (save-selected-window + (split-window-horizontally) + (other-window 1) + (if pbuf + (switch-to-buffer pbuf) + ;; there's no playlist - create one + (setq pbuf (emms-playlist-current-clear)) + (switch-to-buffer pbuf)) + ;; make q in the playlist window hide the linked browser + (when (boundp 'emms-playlist-mode-map) + (define-key emms-playlist-mode-map (kbd "q") + (lambda () + (interactive) + (emms-browser-hide-linked-window) + (bury-buffer)))) + (setq pwin (get-buffer-window pbuf)))) + pwin)) + +(defun emms-browser-hide-linked-window () + "Delete a playlist or browser window when the other is hidden." + (interactive) + (let ((other-buf (emms-browser-get-linked-buffer)) + (other-win (emms-browser-get-linked-window))) + (when (and other-win + (window-live-p other-win)) + (delete-window other-win)) + ;; bury the buffer, or it becomes visible when we hide the + ;; linked buffer + (bury-buffer other-buf))) + +;; -------------------------------------------------- +;; Searching +;; -------------------------------------------------- + +(defun emms-browser-filter-cache (search-list) + "Return a list of tracks that match SEARCH-LIST. +SEARCH-LIST is a list of cons pairs, in the form: + + ((field1 field2) string) + +If string matches any of the fields in a cons pair, it will be +included." + + (let (tracks) + (maphash (lambda (_k track) + (when (emms-browser-matches-p track search-list) + (push track tracks))) + emms-cache-db) + tracks)) + +(defun emms-browser-matches-p (track search-list) + (let (no-match matched) + (dolist (item search-list) + (setq matched nil) + (dolist (field (car item)) + (let ((track-field (emms-track-get track field ""))) + (when (and track-field (string-match (cadr item) track-field)) + (setq matched t)))) + (unless matched + (setq no-match t))) + (not no-match))) + +(defun emms-browser-search-buffer-go () + "Create a new search buffer, or clean the existing one." + (switch-to-buffer + (get-buffer-create emms-browser-search-buffer-name)) + (emms-browser-mode t) + (use-local-map emms-browser-search-mode-map) + (emms-with-inhibit-read-only-t + (delete-region (point-min) (point-max)))) + +(defun emms-browser-search (fields) + "Search for STR using FIELDS." + (let* ((prompt (format "Searching with %S: " fields)) + (str (read-string prompt))) + (emms-browser-search-buffer-go) + (emms-with-inhibit-read-only-t + (emms-browser-render-search + (emms-browser-filter-cache + (list (list fields str))))) + (emms-browser-expand-all) + (goto-char (point-min)))) + +(defun emms-browser-render-search (tracks) + (let ((entries + (emms-browser-make-sorted-alist 'info-artist tracks))) + (dolist (entry entries) + (emms-browser-insert-top-level-entry (car entry) + (cdr entry) + 'info-artist)))) + +;; hmm - should we be doing this? +(defun emms-browser-kill-search () + "Kill the buffer when q is hit." + (interactive) + (kill-buffer (current-buffer))) + +(defun emms-browser-search-by-artist () + (interactive) + (emms-browser-search '(info-artist))) + +(defun emms-browser-search-by-composer () + (interactive) + (emms-browser-search '(info-composer))) + +(defun emms-browser-search-by-performer () + (interactive) + (emms-browser-search '(info-performer))) + +(defun emms-browser-search-by-title () + (interactive) + (emms-browser-search '(info-title))) + +(defun emms-browser-search-by-album () + (interactive) + (emms-browser-search '(info-album))) + +(defun emms-browser-search-by-names () + (interactive) + (emms-browser-search '(info-artist info-composer info-performer info-title info-album))) + +;; -------------------------------------------------- +;; Album covers +;; -------------------------------------------------- + +(defun emms-browser--build-cover-filename () + "Build `emms-browser--covers-filename'. + +Based on from `emms-browser-covers' (when a list) and +`emms-browser-covers-file-extensions'." + (setq emms-browser--covers-filename + (mapcar (lambda (cover) + (if (file-name-extension cover) + (list cover) + (mapcar (lambda (ext) (concat cover "." ext)) + emms-browser-covers-file-extensions))) + emms-browser-covers))) + +(defun emms-browser-get-cover-from-album (bdata &optional size) + (cl-assert (eq (emms-browser-bdata-type bdata) 'info-album)) + (let* ((track1data (emms-browser-bdata-data bdata)) + (track1 (car (emms-browser-bdata-data (car track1data)))) + (path (emms-track-get track1 'name))) + (emms-browser-get-cover-from-path path size))) + +(defun emms-browser-get-cover-from-path (path &optional size) + "Return a cover filename, if it exists." + (unless size + (setq size 'medium)) + (let* ((size-idx (cond + ((eq size 'small) 0) + ((eq size 'medium) 1) + ((eq size 'large) 2))) + (cover + (cond + ((functionp emms-browser-covers) + (funcall emms-browser-covers (file-name-directory path) size)) + ((and (listp emms-browser-covers) + (nth size-idx emms-browser-covers)) + (unless emms-browser--covers-filename + (emms-browser--build-cover-filename)) + (car (delq nil + (mapcar (lambda (cover) + (let ((coverpath + (concat (file-name-directory path) cover))) + (and (file-exists-p coverpath) coverpath))) + (nth size-idx emms-browser--covers-filename)))))))) + (if (and cover (file-readable-p cover)) + cover + ;; no cover found, use default + (when emms-browser-default-covers + (nth size-idx emms-browser-default-covers))))) + +(defun emms-browser-insert-cover (path) + (insert (emms-browser-make-cover path))) + +(defun emms-browser-make-cover (path) + (let* ((ext (file-name-extension path)) + (type (cond + ((string= ext "png") 'png) + ((string= ext "xbm") 'xbm) + ((string= ext "xpm") 'xpm) + ((string= ext "pbm") 'pbm) + ((string-match "e?ps" + ext) 'postscript) + ((string= ext "gif") 'gif) + ((string= ext "tiff") 'tiff) + (t 'jpeg)))) + (emms-propertize " " + 'display `(image + :type ,type + :margin 5 + :file ,path) + 'rear-nonsticky '(display)))) + +(defun emms-browser-get-cover-str (path size) + (let ((cover (emms-browser-get-cover-from-path path size))) + (if cover + (emms-browser-make-cover cover) + ;; we use a single space so that cover & no cover tracks line up + ;; in a terminal + " "))) + +;; -------------------------------------------------- +;; Display formats +;; -------------------------------------------------- + +(defun emms-browser-bdata-first-track (bdata) + "Return the first track from a given bdata. +If > album level, most of the track data will not make sense." + (let ((type (emms-browser-bdata-type bdata))) + (if (eq type 'info-title) + (car (emms-browser-bdata-data bdata)) + ;; recurse + (emms-browser-bdata-first-track + (car (emms-browser-bdata-data bdata)))))) + +(defun emms-browser-insert-format (bdata) + (emms-with-inhibit-read-only-t + (insert + (emms-browser-format-line bdata) + "\n"))) + +(defun emms-browser-make-indent (level) + (or + emms-browser-current-indent + (make-string (* 1 (1- level)) ?\s))) + +(defun emms-browser-format-elem (format-string elem) + (cdr (assoc elem format-string))) + +(defun emms-browser-format-line (bdata &optional target) + "Return a propertized string to be inserted in the buffer." + (unless target + (setq target 'browser)) + (let* ((name (or (emms-browser-bdata-name bdata) "misc")) + (level (emms-browser-bdata-level bdata)) + (type (emms-browser-bdata-type bdata)) + (indent (emms-browser-make-indent level)) + (track (emms-browser-bdata-first-track bdata)) + (path (emms-track-get track 'name)) + (face (emms-browser-get-face bdata)) + (format (emms-browser-get-format bdata target)) + (props (list 'emms-browser-bdata bdata)) + (format-choices + `(("i" . ,indent) + ("n" . ,name) + ("y" . ,(emms-track-get-year track)) + ("A" . ,(emms-track-get track 'info-album)) + ("a" . ,(emms-track-get track 'info-artist)) + ("C" . ,(emms-track-get track 'info-composer)) + ("p" . ,(emms-track-get track 'info-performer)) + ("t" . ,(emms-track-get track 'info-title)) + ("D" . ,(emms-browser-disc-number track)) + ("T" . ,(emms-browser-track-number track)) + ("d" . ,(emms-browser-track-duration track)))) + str) + (when (equal type 'info-album) + (setq format-choices (append format-choices + `(("cS" . ,(emms-browser-get-cover-str path 'small)) + ("cM" . ,(emms-browser-get-cover-str path 'medium)) + ("cL" . ,(emms-browser-get-cover-str path 'large)))))) + + + (when (functionp format) + (setq format (funcall format bdata format-choices))) + + (setq str + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (let ((start (point-min))) + ;; jump over any image + (when (re-search-forward "%c[SML]" nil t) + (setq start (point))) + ;; jump over the indent + (when (re-search-forward "%i" nil t) + (setq start (point))) + (add-text-properties start (point-max) + (list 'face face))) + (buffer-string))) + + (setq str (emms-browser-format-spec str format-choices)) + + ;; give tracks a 'boost' if they're not top-level + ;; (covers take up an extra space) + (when (and (eq type 'info-title) + (not (string= indent ""))) + (setq str (concat " " str))) + + ;; if we're in playlist mode, add a track + (when (and (eq target 'playlist) + (eq type 'info-title)) + (setq props + (append props `(emms-track ,track)))) + + ;; add properties to the whole string + (add-text-properties 0 (length str) props str) + str)) + +(defun emms-browser-get-face (bdata) + "Return a suitable face for BDATA." + (let* ((type (emms-browser-bdata-type bdata)) + (name (cond + ((or (eq type 'info-year) + (eq type 'info-genre)) "year/genre") + ((eq type 'info-artist) "artist") + ((eq type 'info-composer) "composer") + ((eq type 'info-performer) "performer") + ((eq type 'info-album) "album") + ((eq type 'info-title) "track")))) + (intern + (concat "emms-browser-" name "-face")))) + +;; based on gnus code +(defun emms-browser-format-spec (format specification) + "Return a string based on FORMAT and SPECIFICATION. +FORMAT is a string containing `format'-like specs like \"bash %u %k\", +while SPECIFICATION is an alist mapping from format spec characters +to values. Any text properties on a %-spec itself are propagated to +the text that it generates." + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((eq (char-after) ?%) + (delete-char 1)) + ;; Valid format spec. + ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]+\\)") + (let* ((num (match-string 1)) + (spec (match-string 2)) + (val-alist (assoc spec specification)) + (val (cdr val-alist))) + (unless val-alist + (error "Invalid format character: %s" spec)) + ;; Value for a valid spec may not exist. Not an error, just nothing to show. + (unless val (setq val "")) + ;; Pad result to desired length. + (let ((text (format (concat "%" num "s") val))) + ;; Insert first, to preserve text properties. + (insert-and-inherit text) + ;; Delete the specifier body. + (delete-region (+ (match-beginning 0) (length text)) + (+ (match-end 0) (length text))) + ;; Delete the percent sign. + (delete-region (1- (match-beginning 0)) (match-beginning 0))))) + ;; Signal an error on bogus format strings. + (t + (error "Invalid format string")))) + (buffer-string))) + +;; -------------------------------------------------- +;; Display formats - defaults +;; -------------------------------------------------- + +;; FIXME: optional format strings would avoid having to define a +;; function for specifiers which may be empty. + +(defvar emms-browser-default-format "%i%n" + "indent + name") + +;; tracks +(defvar emms-browser-info-title-format + 'emms-browser-track-artist-and-title-format) +(defvar emms-browser-playlist-info-title-format + 'emms-browser-track-artist-and-title-format) + +(defun emms-browser-get-format (bdata target) + (let* ((type (emms-browser-bdata-type bdata)) + (target-str (or + (and (eq target 'browser) "") + (concat (symbol-name target) "-"))) + (sym + (intern + (concat "emms-browser-" + target-str + (symbol-name type) + "-format")))) + (if (boundp sym) + (symbol-value sym) + emms-browser-default-format))) + +(defun emms-browser-track-artist-and-title-format (_bdata fmt) + (concat + "%i" + (let ((track (emms-browser-format-elem fmt "T"))) + (if (and track (not (string= track "0"))) + "%T. " + "")) + "%n")) + +;; albums - we define two formats, one for a small cover (browser), +;; and one for a medium sized cover (playlist). +(defvar emms-browser-info-album-format + 'emms-browser-year-and-album-fmt) +(defvar emms-browser-playlist-info-album-format + 'emms-browser-year-and-album-fmt-med) + +(defun emms-browser-year-and-album-fmt (_bdata fmt) + (concat + "%i%cS" + (let ((year (emms-browser-format-elem fmt "y"))) + (if (and year (not (string= year "0"))) + "(%y) " + "")) + "%n")) + +(defun emms-browser-year-and-album-fmt-med (_bdata fmt) + (concat + "%i%cM" + (let ((year (emms-browser-format-elem fmt "y"))) + (if (and year (not (string= year "0"))) + "(%y) " + "")) + "%n")) + +;; -------------------------------------------------- +;; Display faces +;; -------------------------------------------------- + +(defmacro emms-browser-make-face (name dark-col light-col height) + (let ((face-name (intern (concat "emms-browser-" name "-face")))) + `(defface ,face-name + '((((class color) (background dark)) + (:foreground ,dark-col + :height ,height)) + (((class color) (background light)) + (:foreground ,light-col + :height ,height)) + (((type tty) (class mono)) + (:inverse-video t)) + (t (:background ,dark-col))) + ,(concat "Face for " + name + " in a browser/playlist buffer.")))) + +(emms-browser-make-face "year/genre" "#aaaaff" "#444477" 1.5) +(emms-browser-make-face "artist" "#aaaaff" "#444477" 1.3) +(emms-browser-make-face "composer" "#aaaaff" "#444477" 1.3) +(emms-browser-make-face "performer" "#aaaaff" "#444477" 1.3) +(emms-browser-make-face "album" "#aaaaff" "#444477" 1.1) +(emms-browser-make-face "track" "#aaaaff" "#444477" 1.0) + +;; -------------------------------------------------- +;; Filtering +;; -------------------------------------------------- + +(defvar emms-browser-filters nil + "A list of available filters.") + +(defmacro emms-browser-make-filter (name func) + "Make a user-level function for filtering tracks. +This: + - defines an interactive function M-x emms-browser-show-NAME. + - defines a variable emms-browser-filter-NAME of (name . func). + - adds the filter to `emms-browser-filters'." + (let ((funcnam (intern (concat "emms-browser-show-" name))) + (var (intern (concat "emms-browser-filter-" name))) + (desc (concat "Filter the cache using rule '" + name "'"))) + `(progn + (defvar ,var nil ,desc) + (setq ,var (cons ,name ,func)) + (add-to-list 'emms-browser-filters ,var) + (defun ,funcnam () + ,desc + (interactive) + (emms-browser-refilter ,var))))) + +(defun emms-browser-set-filter (filter) + "Set the current filter to be used on next update. +This does not refresh the current buffer." + (setq emms-browser-filter-tracks-hook (cdr filter)) + (setq emms-browser-current-filter-name (car filter)) + (run-hooks 'emms-browser-filter-changed-hook)) + +(defun emms-browser-refilter (filter) + "Filter and render the top-level tracks." + (emms-browser-set-filter filter) + (emms-browse-by (or emms-browser-top-level-type + emms-browser-default-browse-type))) + +(defun emms-browser-next-filter (&optional reverse) + "Redisplay with the next filter." + (interactive) + (let* ((list (if reverse + (reverse emms-browser-filters) + emms-browser-filters)) + (key emms-browser-current-filter-name) + (next (cadr (member (assoc key list) list)))) + ;; wrapped + (unless next + (setq next (car list))) + (emms-browser-refilter next))) + +(defun emms-browser-previous-filter () + "Redisplay with the previous filter." + (interactive) + (emms-browser-next-filter t)) + +(defun emms-browser-filter-only-dir (dirname) + "Generate a function which checks if a track is in DIRNAME. +If the track is not in DIRNAME, return t." + (let ((re (concat "^" (expand-file-name dirname)))) + (lambda (track) + (not (string-match re (emms-track-get track 'name)))))) + +(defun emms-browser-filter-only-type (type) + "Generate a function which checks a track's type. +If the track is not of TYPE, return t." + (lambda (track) + (not (eq type (emms-track-get track 'type))))) + +;; seconds in a day (* 60 60 24) = 86400 +(defun emms-browser-filter-only-recent (days) + "Show only tracks played within the last number of DAYS." + (lambda (track) + (let ((min-date (time-subtract + (current-time) + (seconds-to-time (* days 86400)))) + last-played) + (not (and (setq last-played + (emms-track-get track 'last-played nil)) + (time-less-p min-date last-played)))))) + + +;; TODO: Add function to clear the cache from thumbnails that have no associated +;; cover folders. This is especially useful in case the music library path +;; changes: currently, all covers will have to be re-cached while the old ones +;; are left as is, useless. + +;; TODO: `emms-browser-expand-all' is slow because of all the covers (about 30 +;; sec fot 1500 covers in my case). Try to profile & optimize. It will +;; probably not be enough and we might need to run emms-browser-expand-all +;; asynchronously. + + +(defvar emms-browser-thumbnail-directory (expand-file-name "thumbnails" emms-directory) + "Directory where to store cover thumbnails.") + +(defvar emms-browser-thumbnail-small-size 128 + "Cover thumbnail will be resized if necessary so that neither + width nor height exceed this dimension.") +(defvar emms-browser-thumbnail-medium-size 256 + "Cover thumbnail will be resized if necessary so that neither + width nor height exceed this dimension.") +(defvar emms-browser-thumbnail-large-size 1024 ; Emms does not use large covers as of 2017-11-26. + "Cover thumbnail will be resized if necessary so that neither + width nor height exceed this dimension.") + +(defun emms-browser-thumbnail-filter-default (dir) + "Select covers containing \\='front\\=' or \\='cover\\=' in DIR. +If none was found, fallback on `emms-browser-thumbnail-filter-all\\='. + +See `emms-browser-thumbnail-filter\\='." + (when (file-directory-p dir) + (let ((ls (directory-files dir t nil t)) + (case-fold-search t) + covers) + (dolist (ext emms-browser-covers-file-extensions) + (setq covers (append (seq-filter (lambda (c) (string-match (concat "\\(front\\|cover\\).*\\." ext) c)) ls) covers))) + (unless covers + (setq covers (emms-browser-thumbnail-filter-all dir))) + covers))) + +(defun emms-browser-thumbnail-filter-all (dir) + "Return the list of all files with `emms-browser-covers-file-extensions\\=' in DIR. + +See `emms-browser-thumbnail-filter'." + (let (covers) + (dolist (ext emms-browser-covers-file-extensions covers) + (setq covers (append (file-expand-wildcards (expand-file-name (concat "*." ext) dir)) covers))))) + +(defvar emms-browser-thumbnail-filter 'emms-browser-thumbnail-filter-default + "This filter must hold a function that takes a directory argument and returns +a list of cover file names. + +The list will be processed by `emms-browser-cache-thumbnail'. +See also `emms-browser-thumbnail-filter-default'.") + +(defvar emms-browser-thumbnail-convert-program (executable-find "convert") + "The ImageMagick's `convert' program.") + +(defun emms-browser-cache-thumbnail (dir size) + "Return cached cover SIZE for album in DIR. + +SIZE must be \\='small, \\='medium or \\='large. It will determine the +resolution of the cached file. See the variables +`emms-browser-thumbnail-SIZE-size\\='. + +If cover is not cached or if cache is out-of-date, re-cache it. +If both the width and the height of the cover are smaller than +`emms-browser-thumbnail-SIZE-size\\=', it need not be cached and +will be used directly. + +Emms assumes that you have one album per folder. This function +will always use the same cover per folder. + +`emms-browser-covers\\=' can be `fset\\=' to this function." + (if (eq size 'large) + ;; 'large is unused for now. Return empty. + nil + (let (covers + cover + (cover-width 0) (cover-height 0) + (size-value (symbol-value (intern (concat "emms-browser-thumbnail-" (symbol-name size) "-size")))) + cache-dest-file) + (setq covers (funcall emms-browser-thumbnail-filter dir)) + (if (not covers) + nil + ;; Find best quality cover. + (let (res) + (dolist (c covers) + (setq res (image-size (create-image c) t)) + ;; image-size does not error, it returns (30 . 30) instead. + (and (> (car res) 30) (> (cdr res) 30) + (< cover-width (car res)) (< cover-height (cdr res)) + (setq cover-width (car res) cover-height (cdr res) cover c)))) + (if (and (>= size-value cover-width) (>= size-value cover-height)) + ;; No need to resize and cache. + cover + (let ((cache-dest (concat emms-browser-thumbnail-directory (file-name-directory cover)))) + (mkdir cache-dest t) + (setq cache-dest-file (concat + (expand-file-name "cover_" cache-dest) + (symbol-name size) + "." (file-name-extension cover)))) + (and emms-browser-thumbnail-convert-program + (or (not (file-exists-p cache-dest-file)) + (time-less-p (nth 5 (file-attributes cache-dest-file)) + (nth 5 (file-attributes cover)) )) + (let (err msg) + ;; An Elisp function would be faster, but Emacs does not seem be be + ;; able to resize image files. It can resize image displays though. + ;; TODO: Add image resizing support to Emacs. + (setq msg (with-output-to-string + (with-current-buffer standard-output + (setq err (call-process (executable-find "convert") nil '(t t) nil + "-resize" (format "%sx%s" size-value size-value) + cover + cache-dest-file))))) + (when (/= err 0) + (warn "%s" msg) + (setq cache-dest-file nil)))) + cache-dest-file))))) + +(defvar emms-browser--cache-hash nil + "Cache for `emms-browser-cache-thumbnail-async'.") + +(defun emms-browser-cache-thumbnail-async (dir size) + "Like `emms-browser-cache-thumbnail' but caches queries for faster lookups. +The drawback is that if changes are made to the covers in DIR +after `emms-browser-cache-thumbnail-async' queried them, it won't +be taken into account. Call `emms-browser-clear-cache-hash' to +refresh the cache." + (unless emms-browser--cache-hash + (setq emms-browser--cache-hash (make-hash-table :test 'equal))) + (let* ((key (cons dir size)) + (val (gethash key emms-browser--cache-hash))) + (or val + (puthash key (emms-browser-cache-thumbnail dir size) + emms-browser--cache-hash)))) + +(defun emms-browser-clear-cache-hash () + "Resets `emms-browser-cache-thumbnail-async' cache. +This is useful if there were changes on disk after +`emms-browser-cache-thumbnail-async' first cached them." + (interactive) + (clrhash emms-browser--cache-hash)) + +(provide 'emms-browser) +;;; emms-browser.el ends here diff --git a/elisp/emms-cache.el b/elisp/emms-cache.el new file mode 100644 index 0000000..0b52bbb --- /dev/null +++ b/elisp/emms-cache.el @@ -0,0 +1,193 @@ +;;; emms-cache.el --- persistence for emms-track -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009, 2022 Free Software Foundation, Inc. + +;; Author: Damien Elmes , Yoni Rabkin +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The cache is a mapping of a full path name to information, and so +;; it is invalidated when you rename or move files about. It also +;; does not differentiate between file or uri tracks. + +;; Because cache lookups are much faster than disk access, this works +;; much better with a emms-later-do-interval of something like 0.001. Also +;; consider using synchronous mode, as it's quite fast now. + +;; This code is activated by (emms-standard) and above. + +;; To activate it by hand, use: + +;; (emms-cache 1) + +;;; Code: + +(require 'emms) +(require 'emms-info) + +(when (fboundp 'define-hash-table-test) + (define-hash-table-test 'string-hash 'string= 'sxhash)) + +(defvar emms-cache-db (make-hash-table + :test (if (fboundp 'define-hash-table-test) + 'string-hash + 'equal)) + "A mapping of paths to file info. +This is used to cache over emacs sessions.") + +(defvar emms-cache-dirty nil + "True if the cache has been updated since init.") + +(defcustom emms-cache-file (concat (file-name-as-directory emms-directory) "cache") + "A file used to store cached file information over sessions." + :group 'emms + :type 'file) + +(defcustom emms-cache-file-coding-system 'utf-8 + "Coding system used for saving `emms-cache-file'." + :group 'emms + :type 'coding-system) + +(defun emms-cache (arg) + "Turn on Emms caching if ARG is positive, off otherwise." + (interactive "p") + (if (and arg (> arg 0)) + (progn + (unless emms-cache-dirty + (emms-cache-restore)) + (unless noninteractive + (add-hook 'kill-emacs-hook 'emms-cache-save)) + (setq emms-cache-get-function 'emms-cache-get) + (setq emms-cache-set-function 'emms-cache-set) + (setq emms-cache-modified-function 'emms-cache-dirty)) + (remove-hook 'kill-emacs-hook 'emms-cache-save) + (setq emms-cache-get-function nil) + (setq emms-cache-set-function nil) + (setq emms-cache-modified-function nil))) + +;;;###autoload +(defun emms-cache-enable () + "Enable caching of Emms track data." + (interactive) + (emms-cache 1) + (message "Emms cache enabled")) + +;;;###autoload +(defun emms-cache-disable () + "Disable caching of Emms track data." + (interactive) + (emms-cache -1) + (message "Emms cache disabled")) + +;;;###autoload +(defun emms-cache-toggle () + "Toggle caching of Emms track data." + (interactive) + (if emms-cache-get-function + (emms-cache-disable) + (emms-cache-enable))) + +(defsubst emms-cache-dirty (&rest _ignored) + "Mark the cache as dirty." + (setq emms-cache-dirty t)) + +(defun emms-cache-get (type path) + "Return a cache element for PATH, or nil." + (ignore type) ;; implicitly ignored before 2021-03-02 + (gethash path emms-cache-db)) + +(defun emms-cache-set (type path track) + "Set PATH to TRACK in the cache." + (ignore type) ;; implicitly ignored before 2021-03-02 + (puthash path track emms-cache-db) + (emms-cache-dirty)) + +(defun emms-cache-del (path) + "Remove a track from the cache, with key PATH." + (remhash path emms-cache-db) + (emms-cache-dirty)) + +(defun emms-cache-save () + "Save the track cache to a file." + (interactive) + (when emms-cache-dirty + (message "Saving emms track cache...") + (with-temp-buffer + (insert + (concat ";;; .emms-cache -*- mode: emacs-lisp; coding: " + (symbol-name emms-cache-file-coding-system) + "; -*-\n")) + (maphash (lambda (k v) + (insert (format + "(puthash %S '%S emms-cache-db)\n" k v))) + emms-cache-db) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system emms-cache-file-coding-system)) + (unless (file-directory-p (file-name-directory emms-cache-file)) + (make-directory (file-name-directory emms-cache-file))) + (write-region (point-min) (point-max) emms-cache-file) + (message "Saving emms track cache...done")) + (setq emms-cache-dirty nil))) + +(defun emms-cache-restore () + "Restore the track cache from a file." + (interactive) + (load emms-cache-file t nil t) + (setq emms-cache-dirty nil)) + +(defun emms-cache-sync (arg) + "Sync the cache with the data on disc. +Remove non-existent files, and update data for files which have +been modified. With prefix argument, update data for all files +regardless of whether they have been modified or not." + (interactive "P") + (let (removed) + (maphash (lambda (path track) + (when (emms-track-file-p track) + ;; if no longer here, remove + (if (not (file-exists-p path)) + (progn + (remhash path emms-cache-db) + (setq removed t)) + (let ((file-mtime (emms-info-track-file-mtime track)) + (info-mtime (emms-track-get track 'info-mtime))) + (when (or (not info-mtime) + (emms-time-less-p info-mtime file-mtime) + arg) + (emms-info-initialize-track track arg)))))) + emms-cache-db) + (when removed + (setq emms-cache-dirty t)))) + +(defun emms-cache-reset () + "Reset the cache." + (interactive) + (when (yes-or-no-p "Really reset the cache? ") + (setq emms-cache-db + (make-hash-table + :test (if (fboundp 'define-hash-table-test) + 'string-hash + 'equal))) + (setq emms-cache-dirty t) + (emms-cache-save))) + +(provide 'emms-cache) +;;; emms-cache.el ends here diff --git a/elisp/emms-compat.el b/elisp/emms-compat.el new file mode 100644 index 0000000..55a851f --- /dev/null +++ b/elisp/emms-compat.el @@ -0,0 +1,185 @@ +;;; emms-compat.el --- Compatibility routines for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Michael Olson + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; These are functions and macros that EMMS needs in order to be +;; compatible with various Emacs and XEmacs versions. + +;;; Code: + + +;;; Miscellaneous + +(defun emms-propertize (string &rest properties) + (if (fboundp 'propertize) + (apply #'propertize string properties) + (set-text-properties 0 (length string) properties string) + string)) + +;; Emacs accepts three arguments to `make-obsolete', but the XEmacs +;; version only takes two arguments +(defun emms-make-obsolete (old-name new-name when) + "Make the byte-compiler warn that OLD-NAME is obsolete. +The warning will say that NEW-NAME should be used instead. +WHEN should be a string indicating when the function was +first made obsolete, either the file's revision number or an +EMMS release version number." + (if (featurep 'xemacs) + (make-obsolete old-name new-name) + (make-obsolete old-name new-name when))) + + +;;; Time and timers + +(defun emms-cancel-timer (timer) + "Cancel the given TIMER." + (when timer + (cond ((fboundp 'cancel-timer) + (cancel-timer timer)) + ((fboundp 'delete-itimer) + (delete-itimer timer))))) + +(defun emms-time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + + +;;; Highline + +(defun emms-activate-highlighting-mode () + "Activate highline mode." + (if (featurep 'xemacs) + (progn + (require 'highline) + (highline-local-mode 1)) + (progn + (require 'hl-line) + (hl-line-mode 1)))) + +(declare-function hl-line-highlight "" nil) + +;; called from emms-lyrics +(defun emms-line-highlight () + "Highlight the current line. You must call +emms-activate-highlighting-mode beforehand." + (if (featurep 'xemacs) + (highline-highlight-current-line) + (hl-line-highlight))) + + +;;; Movement and position + +(defun emms-move-beginning-of-line (arg) + "Move point to beginning of current line as displayed. +If there's an image in the line, this disregards newlines +which are part of the text that the image rests on." + (if (fboundp 'move-beginning-of-line) + (move-beginning-of-line arg) + (if (numberp arg) + (forward-line (1- arg)) + (forward-line 0)))) + +(defun emms-line-number-at-pos (&optional pos) + "Return (narrowed) buffer line number at position POS. +If POS is nil, use current buffer location." + (if (fboundp 'line-number-at-pos) + (line-number-at-pos pos) + (let ((opoint (or pos (point))) start) + (save-excursion + (goto-char (point-min)) + (setq start (point)) + (goto-char opoint) + (forward-line 0) + (1+ (count-lines start (point))))))) + + +;;; Regular expression matching + +(defun emms-replace-regexp-in-string (regexp replacement text + &optional fixedcase literal) + "Replace REGEXP with REPLACEMENT in TEXT. +If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text. +If fifth arg LITERAL is non-nil, insert REPLACEMENT literally." + (cond + ((fboundp 'replace-regexp-in-string) + (replace-regexp-in-string regexp replacement text fixedcase literal)) + ((and (featurep 'xemacs) (fboundp 'replace-in-string)) + (replace-in-string text regexp replacement literal)) + (t (let ((repl-len (length replacement)) + start) + (save-match-data + (while (setq start (string-match regexp text start)) + (setq start (+ start repl-len) + text (replace-match replacement fixedcase literal text))))) + text))) + +(defun emms-match-string-no-properties (num &optional string) + (if (fboundp 'match-string-no-properties) + (match-string-no-properties num string) + (match-string num string))) + + +;;; Common Lisp + +(defun emms-delete-if (predicate seq) + "Remove all items satisfying PREDICATE in SEQ. +This is a destructive function: it reuses the storage of SEQ +whenever possible." + ;; remove from car + (while (when (funcall predicate (car seq)) + (setq seq (cdr seq)))) + ;; remove from cdr + (let ((ptr seq) + (next (cdr seq))) + (while next + (when (funcall predicate (car next)) + (setcdr ptr (if (consp next) + (cdr next) + nil))) + (setq ptr (cdr ptr)) + (setq next (cdr ptr)))) + seq) + +(defun emms-find-if (predicate seq) + "Find the first item satisfying PREDICATE in SEQ. +Return the matching item, or nil if not found." + (catch 'found + (dolist (el seq) + (when (funcall predicate el) + (throw 'found el))))) + +(defun emms-remove-if-not (predicate seq) + "Remove all items not satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ to +avoid corrupting the original SEQ." + (let (newseq) + (dolist (el seq) + (when (funcall predicate el) + (setq newseq (cons el newseq)))) + (nreverse newseq))) + +(provide 'emms-compat) +;;; emms-compat.el ends here diff --git a/elisp/emms-cue.el b/elisp/emms-cue.el new file mode 100644 index 0000000..880d2d8 --- /dev/null +++ b/elisp/emms-cue.el @@ -0,0 +1,120 @@ +;;; emms-cue.el --- Recognize cue sheet file -*- lexical-binding: t; -*- + +;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: William Xu + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; By parsing cue file, we will be able to play next/previous track from a +;; single .ape or .flac file. + +;;; Code: + +(require 'emms-playing-time) +(require 'emms-info) + +(defun emms-cue-next () + "Play next track from .cue file." + (interactive) + (let ((cue-track (emms-cue-next-track))) + (if (cdr cue-track) + (progn + (emms-seek-to (cdr cue-track)) + (message "Will play: %s" (car cue-track))) + (message "Nothing to seek or missing .cue file?")))) + +(defun emms-cue-previous () + "Play previous track from .cue file." + (interactive) + (let ((cue-track (emms-cue-previous-track))) + (if (cdr cue-track) + (progn + (emms-seek-to (cdr cue-track)) + (message "Will play: %s" (car cue-track))) + (message "Nothing to seek or missing .cue file?")))) + +(defun emms-cue-next-track (&optional previous-p) + "Get title and offset of next track from .cue file. + +When PREVIOUS-P is t, get previous track info instead." + (let* ((track (emms-playlist-current-selected-track)) + (name (emms-track-get track 'name)) + (cue (concat (file-name-sans-extension name)".cue"))) + (when (file-exists-p cue) + (with-temp-buffer + (emms-insert-file-contents cue) + (save-excursion + (if previous-p + (goto-char (point-max)) + (goto-char (point-min))) + (let ((offset nil) + (title "") + ;; We should search one more track far when getting previous + ;; track. + (one-more-track previous-p)) + (while (and (not offset) + (funcall + (if previous-p 'search-backward-regexp 'search-forward-regexp) + "INDEX 01 \\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)" nil t 1)) + (let* ((min (string-to-number (match-string-no-properties 1))) + (sec (string-to-number (match-string-no-properties 2))) + (msec (string-to-number (match-string-no-properties 3))) + (total-sec (+ (* min 60) sec (/ msec 100.0)))) + (when (funcall (if previous-p '> '<) emms-playing-time total-sec) + (if (not one-more-track) + (progn + (setq offset total-sec) + (when (search-backward-regexp "TITLE \"\\(.*\\)\"" nil t 1) + (setq title (match-string-no-properties 1)))) + (setq one-more-track nil))))) + (cons title offset))))))) + +(defun emms-cue-previous-track () + "See `emms-cue-next-track'." + (emms-cue-next-track t)) + +(defun emms-info-cueinfo (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (emms-track-file-p track) + (string-match "\\.\\(ape\\|flac\\)\\'" (emms-track-name track))) + (let ((cue (concat (file-name-sans-extension (emms-track-name track)) + ".cue"))) + (when (file-exists-p cue) + (with-temp-buffer + (emms-insert-file-contents cue) + (save-excursion + (mapc (lambda (i) + (goto-char (point-min)) + (when (let ((case-fold-search t)) + (search-forward-regexp + (concat (car i) " \\(.*\\)") nil t 1)) + (emms-track-set track + (cdr i) + (replace-regexp-in-string + "\\`\"\\|\"\\'" "" (match-string 1))))) + '(("performer" . info-artist) + ("title" . info-album) + ("title" . info-title) + ("rem date" . info-year))))))))) + + +(provide 'emms-cue) +;;; emms-cue.el ends here diff --git a/elisp/emms-history.el b/elisp/emms-history.el new file mode 100644 index 0000000..973113d --- /dev/null +++ b/elisp/emms-history.el @@ -0,0 +1,131 @@ +;;; emms-history.el -- save all playlists when exiting emacs -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. +;; +;; Author: Ye Wenbin + +;; This file is part of EMMS. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Saves all playlists when you close emacs. When you start it up again use +;; M-x emms-history-load to restore all saved playlists. + +;; To use it put the following into your ~/.emacs: +;; +;; (require 'emms-history) +;; +;; If all playlists should be restored on startup add this, too: +;; +;; (emms-history-load) + +;;; Code: + +(require 'emms) + +(defgroup emms-history nil + "Saving and restoring all playlists when closing/restarting +Emacs." + :prefix "emms-history-" + :group 'emms) + +(defcustom emms-history-file (concat (file-name-as-directory emms-directory) "history") + "The file to save playlists in." + :type 'string) + +(defcustom emms-history-start-playing nil + "If non-nil emms starts playing the current track after +`emms-history-load' was invoked." + :type 'boolean) + +(defcustom emms-history-file-coding-system 'utf-8 + "Coding system used for saving `emms-history-file'." + :type 'coding-system) + +(defun emms-history-save () + "Save all playlists that are open in this Emacs session." + (interactive) + (when (stringp emms-history-file) + (let ((oldbuf emms-playlist-buffer) + ;; print with no limit + print-length print-level + emms-playlist-buffer playlists) + (save-excursion + (dolist (buf (emms-playlist-buffer-list)) + (set-buffer buf) + (when (> (buffer-size) 0) ; make sure there is track in the buffer + (setq emms-playlist-buffer buf + playlists + (cons + (list (buffer-name) + (or + (and emms-playlist-selected-marker + (marker-position emms-playlist-selected-marker)) + (point-min)) + (save-restriction + (widen) + (nreverse + (emms-playlist-tracks-in-region (point-min) + (point-max))))) + playlists)))) + (with-temp-buffer + (insert + (concat ";;; emms history -*- mode: emacs-lisp; coding: " + (symbol-name emms-history-file-coding-system) + "; -*-\n")) + (insert "(\n;; active playlist\n") + (prin1 (buffer-name oldbuf) (current-buffer)) + (insert "\n;; playlists: ((BUFFER_NAME SELECT_POSITION TRACKS) ...)\n") + (prin1 playlists (current-buffer)) + (insert "\n;; play method\n") + (prin1 `((emms-repeat-track . ,emms-repeat-track) + (emms-repeat-playlist . ,emms-repeat-playlist)) + (current-buffer)) + (insert "\n)") + (write-file emms-history-file)))))) + +(unless noninteractive + (add-hook 'kill-emacs-hook 'emms-history-save)) + +(defun emms-history-load () + "Restore all playlists in `emms-history-file'." + (interactive) + (when (and (stringp emms-history-file) + (file-exists-p emms-history-file)) + (let (history buf) + (with-temp-buffer + (emms-insert-file-contents emms-history-file) + (setq history (read (current-buffer))) + (dolist (playlist (cadr history)) + (with-current-buffer (emms-playlist-new (car playlist)) + (setq emms-playlist-buffer (current-buffer)) + (if (string= (car playlist) (car history)) + (setq buf (current-buffer))) + (mapc 'emms-playlist-insert-track + (nth 2 playlist)) + (run-hooks 'emms-playlist-source-inserted-hook) + (ignore-errors + (emms-playlist-select (cadr playlist))))) + (setq emms-playlist-buffer buf) + (dolist (method (nth 2 history)) + (set (car method) (cdr method))) + (ignore-errors + (when emms-history-start-playing + (emms-start))))))) + +(provide 'emms-history) +;;; emms-history.el ends here diff --git a/elisp/emms-i18n.el b/elisp/emms-i18n.el new file mode 100644 index 0000000..4926858 --- /dev/null +++ b/elisp/emms-i18n.el @@ -0,0 +1,180 @@ +;;; emms-i18n.el --- functions for handling coding systems -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Ye Wenbin + +;; This file is part of EMMS. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or (at +;; your option) any later version. + +;; This program 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 +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; When reading from process, first check the car part of +;; `emms-i18n-default-coding-system'; if non-nil, use this for +;; decoding, and never detect coding system; if nil, first call +;; `emms-i18n-coding-detect-functions' to get coding system, if +;; success, decode the result, otherwise, use +;; `emms-i18n-detect-coding-function', the Emacs detect coding +;; function, if the coding detected is not in +;; `emms-i18n-never-used-coding-system', decode it, otherwise use +;; locale-coding-system. + +;; When writing/sending data to process, first check the cdr part of +;; `emms-i18n-default-coding-system', if non-nil, use this to encode +;; data, otherwise do nothing, that means use +;; `default-process-coding-system' or `process-coding-system-alist' to +;; encode data. + +;; Put this file into your load-path and the following into your +;; ~/.emacs: + +;; (require 'emms-i18n) + +;;; Code: + +(provide 'emms-i18n) + +;; TODO: Use defcustom. +(defvar emms-i18n-never-used-coding-system + '(raw-text undecided) + "If the `emms-i18n-coding-detect-functions' return a coding +system in this list, use `emms-i18n-default-coding-system' +instead.") + +;; TODO: Use defcustom. +(defvar emms-i18n-coding-system-for-read + 'utf-8 + "If coding detect fails, use this for decoding.") + +;; TODO: Use defcustom. +(defvar emms-i18n-default-coding-system + '(no-conversion . no-conversion) + "If non-nil, use this for decoding and encoding.") + +;; TODO: Use defcustom. +(defvar emms-i18n-coding-detect-functions + nil + "A list of functions to call to detect codings.") + +;; TODO: Use defcustom. +(defvar emms-i18n-detect-max-size + 10000 + "Maximum amount of bytes to detect the coding system. nil +means to scan the whole buffer.") + +(defun emms-i18n-iconv (from to str) + "Convert string STR from FROM coding to TO coding." + (if (and from to) + (decode-coding-string + (encode-coding-string str to) + from) + str)) + +(defun emms-i18n-iconv-region (beg end from to) + (when (and from to) + (save-restriction + (narrow-to-region beg end) + (encode-coding-region (point-min) (point-max) to) + (decode-coding-region (point-min) (point-max) from)))) + +(defun emms-i18n-iconv-buffer (from to &optional buf) + "Convert buffer BUF from FROM coding to TO coding. BUF +defaults to the current buffer." + (save-excursion + (and buf (set-buffer buf)) + (emms-i18n-iconv-region (point-min) (point-max) from to))) + +(defun emms-i18n-set-default-coding-system (read-coding write-coding) + "Set `emms-i18n-default-coding-system'." + (interactive "zSet coding system for read: \nzSet coding system for write: ") + (setq emms-i18n-default-coding-system + (cons + (and (coding-system-p read-coding) read-coding) + (and (coding-system-p write-coding) write-coding))) + (message (concat + (if (car emms-i18n-default-coding-system) + (format "The coding system for reading is %S." (car emms-i18n-default-coding-system)) + "Good, you want me to detect the coding system!") + (format " The coding system for writing is %S." + (or (cdr emms-i18n-default-coding-system) + (cdr default-process-coding-system)))))) + +(defun emms-i18n-call-process-simple (&rest args) + "Run a program and return the program result. +If the car part of `emms-i18n-default-coding-system' is non-nil, +the program result will be decoded using the car part of +`emms-i18n-default-coding-system'. Otherwise, use +`emms-i18n-coding-detect-functions' to detect the coding system +of the result. If the `emms-i18n-coding-detect-functions' +failed, use `emms-i18n-detect-coding-function' to detect coding +system. If all the coding systems are nil or in +`emms-i18n-never-used-coding-system', decode the result using +`emms-i18n-coding-system-for-read'. + +ARGS are the same as in `call-process', except BUFFER should +always have the value t. Otherwise the coding detection will not +be performed." + (let ((default-process-coding-system (copy-tree default-process-coding-system)) + (process-coding-system-alist nil) exit pos) + (when (eq (nth 2 args) 't) + (setcar default-process-coding-system (car emms-i18n-default-coding-system)) + (setq pos (point))) + (setq exit (apply 'call-process args)) + (when (and (eq (nth 2 args) 't) + (eq (car emms-i18n-default-coding-system) 'no-conversion)) + (save-restriction + (narrow-to-region pos (point)) + (decode-coding-region (point-min) (point-max) (emms-i18n-detect-buffer-coding-system)))) + exit)) + +;; TODO: Is this function useful? +(defun emms-i18n-call-process (&rest args) + "Run the program like `call-process'. If the cdr part of +`emms-i18n-default-coding-system' is non-nil, the string in ARGS +will be encoded by the cdr part of +`emms-i18n-default-coding-system'; otherwise, all parameters are +simply passed to `call-process'." + (with-temp-buffer + (if (cdr emms-i18n-default-coding-system) + (let ((default-process-coding-system emms-i18n-default-coding-system) + (process-coding-system-alist nil)) + (apply 'call-process args)) + (apply 'call-process args)))) + +(defun emms-i18n-detect-coding-function (size) + (detect-coding-region (point) + (+ (if (null emms-i18n-detect-max-size) + size + (min size emms-i18n-detect-max-size)) + (point)) t)) + +(defun emms-i18n-detect-buffer-coding-system (&optional buf) + "Before calling this function, make sure the buffer is literal." + (let ((size (- (point-max) (point-min))) + (_func (append emms-i18n-coding-detect-functions 'emms-i18n-detect-coding-function)) + coding) + (save-excursion + (and buf (set-buffer buf)) + (goto-char (point-min)) + (when (> size 0) + (setq coding (run-hook-with-args-until-success 'func size)) + (if (member (coding-system-base coding) emms-i18n-never-used-coding-system) + (setq coding (emms-i18n-detect-coding-function size)))) + (if (or (null coding) (member (coding-system-base coding) emms-i18n-never-used-coding-system)) + emms-i18n-coding-system-for-read + coding)))) + +;;; emms-i18n.el ends here diff --git a/elisp/emms-info-exiftool.el b/elisp/emms-info-exiftool.el new file mode 100644 index 0000000..55bb46c --- /dev/null +++ b/elisp/emms-info-exiftool.el @@ -0,0 +1,106 @@ +;;; emms-info-exiftool.el --- info-method for EMMS using exiftool -*- lexical-binding: t; -*- + +;; Copyright (C) 2020, 2022 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin (yrk@gnu.org) +;; Keywords: multimedia + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING.. If not, see +;; . + +;;; Commentary: + +;; (setq emms-info-functions '(emms-info-exiftool)) + +;; To use this you would need to have exiftool installed on your +;; system. + + +;;; Code: + +(require 'emms-info) +(require 'json) + + +(defgroup emms-info-exiftool nil + "Options for EMMS." + :group 'emms-info) + +(defvar emms-info-exiftool-field-map + '((info-album . Album) + (info-artist . Artist) + (info-title . Title) + (info-tracknumber . TrackNumber) + (info-composer . Composer) + (info-year . Year) + (info-discnumber . Discnumber) + (info-genre . Genre) + (info-note . Comment) + (info-playing-time . Duration) + (info-albumartist . Albumartist)) + "Mapping for exiftool output.") + + +;; should only be called inside a buffer containing the json output of +;; exiftool +(defun emms-info-exiftool-time () + "Convert from exiftool-time to seconds." + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "duration.+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" + (point-max) t) + (let ((hours (string-to-number (match-string-no-properties 1))) + (minutes (string-to-number (match-string-no-properties 2))) + (seconds (string-to-number (match-string-no-properties 3)))) + (+ (* hours 60 60) + (* minutes 60) + seconds)) + 0))) + +(defun emms-info-exiftool (track) + "Set TRACK info using exiftool." + (when (eq (emms-track-type track) 'file) + (with-temp-buffer + (when (zerop + (let ((coding-system-for-read 'utf-8)) + (call-process "exiftool" nil '(t nil) nil + "-json" (emms-track-name track)))) + (goto-char (point-min)) + (condition-case nil + (let ((json-fields (elt (json-read) 0))) + (mapc + (lambda (field-map) + (let ((emms-field (car field-map)) + (exiftool-field (cdr field-map))) + (let ((track-field (assoc exiftool-field json-fields))) + (when track-field + (emms-track-set + track + emms-field + (cond ((eq emms-field 'info-playing-time) + (emms-info-exiftool-time)) + ((memq emms-field '(info-tracknumber + info-title + info-year + info-discnumber)) + (format "%s" (cdr track-field))) + (t (cdr track-field)))))))) + emms-info-exiftool-field-map)) + (error (message "error while reading track info"))) + track)))) + + +(provide 'emms-info-exiftool) + +;;; emms-info-exiftool.el ends here diff --git a/elisp/emms-info-libtag.el b/elisp/emms-info-libtag.el new file mode 100644 index 0000000..9425a38 --- /dev/null +++ b/elisp/emms-info-libtag.el @@ -0,0 +1,113 @@ +;;; emms-info-libtag.el --- Info-method for EMMS using libtag -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2021 Free Software Foundation, Inc. + +;; Authors: Ulrik Jensen +;; Jorgen Schäfer +;; Keywords: + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This code has been adapted from code found in mp3player.el, written +;; by Jean-Philippe Theberge (jphiltheberge@videotron.ca), Mario +;; Domgoergen (kanaldrache@gmx.de) and Jorgen Schäfer +;; + +;; To activate this method for getting info, use something like: + +;; (require 'emms-info-libtag) +;; (add-hook 'emms-info-functions 'emms-info-libtag) + +;; Note that you should remove emms-info-mp3info and emms-info-ogginfo +;; from the emms-info-functions list if you want to avoid +;; conflicts. For example, to set libtag as your exclusive info +;; provider: + +;; (setq emms-info-functions '(emms-info-libtag)) + +;; You may have to compile the program from source. +;; Make sure that you have libtag installed. +;; In the EMMS source directory do +;; +;; make emms-print-metadata +;; +;; and copy src/emms-print-metadata to your PATH. + +;; If compilation fails and libtag is installed, you may have to +;; change the line +;; +;; #include +;; +;; to the correction location, e.g. +;; +;; #include + +;;; Code: + +(require 'emms-info) + +(defgroup emms-info-libtag nil + "Options for EMMS." + :group 'emms-info) + +(defvar emms-info-libtag-coding-system 'utf-8) + +(defcustom emms-info-libtag-program-name "emms-print-metadata" + "Name of emms-info-libtag program." + :type '(string)) + +(defcustom emms-info-libtag-known-extensions + (regexp-opt '("mp3" "mp4" "m4a" "ogg" "flac" "spx" "wma" "opus")) + "Regexp of known extensions compatible with `emms-info-libtag-program-name'. + +Case is irrelevant." + :type '(string)) + +(defun emms-info-libtag (track) + (when (and (emms-track-file-p track) + (let ((case-fold-search t)) + (string-match + emms-info-libtag-known-extensions + (emms-track-name track)))) + (with-temp-buffer + (when (zerop + (let ((coding-system-for-read 'utf-8)) + (call-process emms-info-libtag-program-name + nil '(t nil) nil + (emms-track-name track)))) + (goto-char (point-min)) + ;; Crush the trailing whitespace + (while (re-search-forward "[[:space:]]+$" nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (while (looking-at "^\\([^=\n]+\\)=\\(.*\\)$") + (let ((name (intern-soft (match-string 1))) + (value (match-string 2))) + (when (> (length value) + 0) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + value)))) + (forward-line 1)))))) + +(provide 'emms-info-libtag) +;;; emms-info-libtag.el ends here diff --git a/elisp/emms-info-metaflac.el b/elisp/emms-info-metaflac.el new file mode 100644 index 0000000..f03925f --- /dev/null +++ b/elisp/emms-info-metaflac.el @@ -0,0 +1,105 @@ +;;; emms-info-metaflac.el --- Info-method for EMMS using metaflac -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. + +;; Author: Matthew Kennedy +;; Keywords: + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301 USA + +;;; Commentary: + +;; This code has been adapted from code found in emms-info-mp3info.el +;; written by Ulrik Jensen which contains the +;; following attribution: + +;; This code has been adapted from code found in mp3player.el, written +;; by Jean-Philippe Theberge (jphiltheberge@videotron.ca), Mario +;; Domgoergen (kanaldrache@gmx.de) and Jorgen Schäfer +;; + +;; To activate this method for getting info, use something like: + +;; (require 'emms-info-metaflac) +;; (add-hook 'emms-info-methods-list 'emms-info-metaflac) + +;;; Code: + +(require 'emms-info) + +(defvar emms-info-metaflac-version "0.1 $Revision: 1.10 $" + "EMMS info metaflac version string.") + +;; $Id: emms-info-mp3info.el,v 1.10 2005/08/12 18:01:16 xwl Exp $ + +(defgroup emms-info-metaflac nil + "An EMMS-info method for getting/setting FLAC tags, using the +external metaflac program" + :group 'emms-info) + +(defcustom emms-info-metaflac-program-name "metaflac" + "The name/path of the metaflac program." + :type 'string) + +(defcustom emms-info-metaflac-options + '("--no-utf8-convert" + "--show-tag=TITLE" + "--show-tag=ARTIST" + "--show-tag=ALBUM" + "--show-tag=NOTE" + "--show-tag=YEAR" + "--show-tag=TRACKNUMBER" + "--show-tag=DISCNUMBER" + "--show-tag=GENRE") + "The argument to pass to `emms-info-metaflac-program-name'." + :type '(repeat string)) + +(defun emms-info-metaflac (track) + "Get the FLAC tag of file TRACK, using `emms-info-metaflac-program' +and return an emms-info structure representing it." + (when (and (emms-track-file-p track) + (string-match "\\.\\(flac\\|FLAC\\)\\'" (emms-track-name track))) + (with-temp-buffer + (when (zerop + (apply 'call-process + emms-info-metaflac-program-name + nil t nil + "--show-total-samples" + "--show-sample-rate" + (append emms-info-metaflac-options + (list (emms-track-name track))))) + (goto-char (point-min)) + (emms-track-set track 'info-playing-time + (/ (string-to-number (buffer-substring (point) (line-end-position))) + (progn + (forward-line 1) + (string-to-number (buffer-substring (point) (line-end-position)))))) + (forward-line 1) + (while (looking-at "^\\([^=\n]+\\)=\\(.*\\)$") + (let ((name (intern (concat "info-" (downcase (match-string 1))))) + (value (match-string 2))) + (when (> (length value) + 0) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + value)))) + (forward-line 1)))))) + +(provide 'emms-info-metaflac) + +;;; emms-info-metaflac.el ends here diff --git a/elisp/emms-info-mp3info.el b/elisp/emms-info-mp3info.el new file mode 100644 index 0000000..5ebc964 --- /dev/null +++ b/elisp/emms-info-mp3info.el @@ -0,0 +1,100 @@ +;;; emms-info-mp3info.el --- Info-method for EMMS using mp3info -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2021 Free Software Foundation, Inc. + +;; Authors: Ulrik Jensen +;; Jorgen Schäfer +;; Keywords: + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This code has been adapted from code found in mp3player.el, written +;; by Jean-Philippe Theberge (jphiltheberge@videotron.ca), Mario +;; Domgoergen (kanaldrache@gmx.de) and Jorgen Schäfer +;; + +;; To activate this method for getting info, use something like: + +;; (require 'emms-info-mp3info) +;; (add-to-list 'emms-info-functions 'emms-info-mp3info) + +;;; Code: + +(require 'emms-info) + +(defvar emms-info-mp3info-version "0.2 $Revision: 1.10 $" + "EMMS info mp3info version string.") +;; $Id: emms-info-mp3info.el,v 1.10 2005/08/12 18:01:16 xwl Exp $ + +(defgroup emms-info-mp3info nil + "An EMMS-info method for getting/setting ID3v1 tags, using the +external mp3info program" + :group 'emms-info) + +(defcustom emms-info-mp3info-coding-system 'utf-8 + "Coding system used in the output of mp3info." + :type 'coding-system) + +(defcustom emms-info-mp3info-program-name "mp3info" + "The name/path of the mp3info tag program." + :type 'string) + +(defcustom emms-info-mp3find-arguments + `("-p" ,(concat "info-artist=%a\\n" + "info-title=%t\\n" + "info-album=%l\\n" + "info-tracknumber=%n\\n" + "info-year=%y\\n" + "info-genre=%g\\n" + "info-note=%c\\n" + "info-playing-time=%S\\n")) + "The argument to pass to `emms-info-mp3info-program-name'. +This should be a list of info-flag=value lines." + :type '(repeat string)) + +(defun emms-info-mp3info (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (emms-track-file-p track) + (string-match "\\.[Mm][Pp]3\\'" (emms-track-name track))) + (with-temp-buffer + (when (zerop + (apply (if (fboundp 'emms-i18n-call-process-simple) + 'emms-i18n-call-process-simple + 'call-process) + emms-info-mp3info-program-name + nil t nil + (append emms-info-mp3find-arguments + (list (emms-track-name track))))) + (goto-char (point-min)) + (while (looking-at "^\\([^=\n]+\\)=\\(.*\\)$") + (let ((name (intern (match-string 1))) + (value (match-string 2))) + (when (> (length value) + 0) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + value)))) + (forward-line 1)))))) + +(provide 'emms-info-mp3info) +;;; emms-info-mp3info.el ends here diff --git a/elisp/emms-info-native.el b/elisp/emms-info-native.el new file mode 100644 index 0000000..15f2d4c --- /dev/null +++ b/elisp/emms-info-native.el @@ -0,0 +1,982 @@ +;;; emms-info-native.el --- Native Emacs Lisp info method for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2023 Free Software Foundation, Inc. + +;; Author: Petteri Hintsanen + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + +;;; Commentary: + +;; This file provides a native emms-info-method for EMMS. Here +;; "native" means a pure Emacs Lisp implementation instead of one +;; relying on external tools or libraries like `emms-info-ogginfo' or +;; `emms-info-libtag'. +;; +;; To use this method, add `emms-info-native' to +;; `emms-info-functions'. +;; +;; The following file formats are supported: +;; +;; - Vorbis: Ogg Vorbis I Profile, filename extension `.ogg', +;; elementary streams only. Based on xiph.org's Vorbis I +;; specification, see URL +;; `https://xiph.org/vorbis/doc/Vorbis_I_spec.html'. +;; +;; - Opus: Ogg Opus profile, filename extension `.opus', elementary +;; streams only. Based on RFC 7845, see URL +;; `https://tools.ietf.org/html/rfc7845.html'. +;; +;; - FLAC streams in native encapsulation format, filename extension +;; `.flac'. Based on xiph.org's FLAC format specification, see URL +;; `https://xiph.org/flac/format.html'. +;; +;; - MP3 files with extension `.mp3' and id3v2 tags. All id3v2 +;; versions should work, but many features like CRC, compression and +;; encryption are not supported. Based on id3v2 Informal Standards, +;; see URL `https://id3.org'. +;; +;; - SPC files with extension `.spc' and id666 tags. This is an audio +;; file based on a memory dump from an SPC700, a special audio chip +;; found within Super Nintendos. +;; +;; Format detection is based solely on filename extension, which is +;; matched case-insensitively. + +;;; Code: + +(require 'bindat) +(require 'cl-lib) +(require 'emms-info) +(require 'emms-info-spc) +(require 'seq) +(require 'subr-x) + +(defconst emms-info-native--max-peek-size (* 2048 1024) + "Maximum buffer size for metadata decoding. +Functions called by `emms-info-native' read certain amounts of +data into a temporary buffer while decoding metadata. This +variable controls the maximum size of that buffer: if more than +`emms-info-native--max-peek-size' bytes are needed, an error is +signaled. + +Technically metadata blocks can have almost arbitrary lengths, +but in practice processing must be constrained to prevent memory +exhaustion in case of garbled or malicious inputs.") + +(defvar emms-info-native--opus-channel-count 0 + "Last decoded Opus channel count. +This is a kludge; it is needed because bindat spec cannot refer +outside itself.") + +(defvar emms-info-native--id3v2-version 0 + "Last decoded id3v2 version. +This is a kludge; it is needed because bindat spec cannot refer +outside itself.") + +;;;; Vorbis code + +(defconst emms-info-native--max-num-vorbis-comments 1024 + "Maximum number of Vorbis comment fields in a stream. +Technically a single Vorbis stream may have up to 2^32 comments, +but in practice processing must be constrained to prevent memory +exhaustion in case of garbled or malicious inputs. + +This limit is used with Opus and FLAC streams as well, since +their comments have almost the same format as Vorbis.") + +(defconst emms-info-native--max-vorbis-comment-size (* 64 1024) + "Maximum length for a single Vorbis comment field. +Technically a single Vorbis comment may have a length up to 2^32 +bytes, but in practice processing must be constrained to prevent +memory exhaustion in case of garbled or malicious inputs. + +This limit is used with Opus and FLAC streams as well, since +their comments have almost the same format as Vorbis.") + +(defconst emms-info-native--max-vorbis-vendor-length 1024 + "Maximum length of Vorbis vendor string. +Technically a vendor string can be up to 2^32 bytes long, but in +practice processing must be constrained to prevent memory +exhaustion in case of garbled or malicious inputs. + +This limit is used with Opus and FLAC streams as well, since +their comments have almost the same format as Vorbis.") + +(defconst emms-info-native--accepted-vorbis-fields + '("album" + "albumartist" + "albumartistsort" + "albumsort" + "artist" + "artistsort" + "composer" + "composersort" + "date" + "discnumber" + "genre" + "label" + "originaldate" + "originalyear" + "performer" + "title" + "titlesort" + "tracknumber" + "year") + "EMMS info fields that are extracted from Vorbis comments.") + +(defconst emms-info-native--vorbis-headers-bindat-spec + '((identification-header struct emms-info-native--vorbis-identification-header-bindat-spec) + (comment-header struct emms-info-native--vorbis-comment-header-bindat-spec)) + "Specification for first two Vorbis header packets. +They are always an identification header followed by a comment +header.") + +(defconst emms-info-native--vorbis-identification-header-bindat-spec + '((packet-type u8) + (eval (unless (= last 1) + (error "Vorbis header type mismatch: expected 1, got %s" + last))) + (vorbis vec 6) + (eval (unless (equal last emms-info-native--vorbis-magic-array) + (error "Vorbis framing mismatch: expected `%s', got `%s'" + emms-info-native--vorbis-magic-array + last))) + (vorbis-version u32r) + (eval (unless (= last 0) + (error "Vorbis version mismatch: expected 0, got %s" + last))) + (audio-channels u8) + (audio-sample-rate u32r) + (bitrate-maximum u32r) + (bitrate-nominal u32r) + (bitrate-minimum u32r) + (blocksize u8) + (framing-flag u8) + (eval (unless (= last 1)) + (error "Vorbis framing bit mismatch: expected 1, got %s" + last))) + "Vorbis identification header specification.") + +(defconst emms-info-native--vorbis-magic-array + [118 111 114 98 105 115] + "Header packet magic pattern `vorbis'.") + +(defconst emms-info-native--vorbis-comment-header-bindat-spec + '((packet-type u8) + (eval (unless (= last 3) + (error "Vorbis header type mismatch: expected 3, got %s" + last))) + (vorbis vec 6) + (eval (unless (equal last emms-info-native--vorbis-magic-array) + (error "Vorbis framing mismatch: expected `%s', got `%s'" + emms-info-native--vorbis-magic-array + last))) + (vendor-length u32r) + (eval (when (> last emms-info-native--max-vorbis-vendor-length) + (error "Vorbis vendor length %s is too long" last))) + (vendor-string vec (vendor-length)) + (user-comments-list-length u32r) + (eval (when (> last emms-info-native--max-num-vorbis-comments) + (error "Vorbis user comment list length %s is too long" + last))) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec)) + (framing-bit u8) + (eval (unless (= last 1)) + (error "Vorbis framing bit mismatch: expected 1, got %s" + last))) + "Vorbis comment header specification.") + +(defconst emms-info-native--vorbis-comment-field-bindat-spec + '((length u32r) + (eval (when (> last emms-info-native--max-vorbis-comment-size) + (error "Vorbis comment length %s is too long" last))) + (user-comment vec (length))) + "Vorbis comment field specification.") + +(defun emms-info-native--extract-vorbis-comments (user-comments) + "Return a decoded list of comments from USER-COMMENTS. +USER-COMMENTS should be a list of Vorbis comments according to +`user-comments' field in +`emms-info-native--vorbis-comment-header-bindat-spec', +`emms-info-native--opus-comment-header-bindat-spec' or +`emms-info-native--flac-comment-block-bindat-spec'. + +Return comments in a list of (FIELD . VALUE) cons cells. Only +FIELDs that are listed in +`emms-info-native--accepted-vorbis-fields' are returned." + (let (comments) + (dolist (user-comment user-comments) + (let* ((comment (cdr (assoc 'user-comment user-comment))) + (pair (emms-info-native--split-vorbis-comment comment))) + (push pair comments))) + (seq-filter (lambda (elt) + (member (car elt) + emms-info-native--accepted-vorbis-fields)) + comments))) + +(defun emms-info-native--split-vorbis-comment (comment) + "Split Vorbis comment to a field-value pair. +Vorbis comments are of form `FIELD=VALUE'. FIELD is a +case-insensitive field name with a restricted set of ASCII +characters. VALUE is an arbitrary UTF-8 encoded octet stream. + +Return a cons cell (FIELD . VALUE), where FIELD is converted to +lower case and VALUE is the decoded value." + (let ((comment-string (decode-coding-string (mapconcat + #'byte-to-string + comment + nil) + 'utf-8))) + (when (string-match "^\\(.+?\\)=\\(.+?\\)$" comment-string) + (cons (downcase (match-string 1 comment-string)) + (match-string 2 comment-string))))) + +;;;; Opus code + +(defconst emms-info-native--opus-headers-bindat-spec + '((identification-header struct emms-info-native--opus-identification-header-bindat-spec) + (comment-header struct emms-info-native--opus-comment-header-bindat-spec)) + "Specification for two first Opus header packets. +They are always an identification header followed by a comment +header.") + +(defconst emms-info-native--opus-identification-header-bindat-spec + '((opus-head vec 8) + (eval (unless (equal last emms-info-native--opus-head-magic-array) + (error "Opus framing mismatch: expected `%s', got `%s'" + emms-info-native--opus-head-magic-array + last))) + (opus-version u8) + (eval (unless (< last 16) + (error "Opus version mismatch: expected < 16, got %s" + last))) + (channel-count u8) + (eval (setq emms-info-native--opus-channel-count last)) + (pre-skip u16r) + (sample-rate u32r) + (output-gain u16r) + (channel-mapping-family u8) + (union (channel-mapping-family) + (0 nil) + (t (struct emms-info-native--opus-channel-mapping-table)))) + "Opus identification header specification.") + +(defconst emms-info-native--opus-head-magic-array + [79 112 117 115 72 101 97 100] + "Opus identification header magic pattern `OpusHead'.") + +(defconst emms-info-native--opus-channel-mapping-table + '((stream-count u8) + (coupled-count u8) + (channel-mapping vec (eval emms-info-native--opus-channel-count))) + "Opus channel mapping table specification.") + +(defconst emms-info-native--opus-comment-header-bindat-spec + '((opus-tags vec 8) + (eval (unless (equal last emms-info-native--opus-tags-magic-array) + (error "Opus framing mismatch: expected `%s', got `%s'" + emms-info-native--opus-tags-magic-array + last))) + (vendor-length u32r) + (eval (when (> last emms-info-native--max-vorbis-vendor-length) + (error "Opus vendor length %s is too long" last))) + (vendor-string vec (vendor-length)) + (user-comments-list-length u32r) + (eval (when (> last emms-info-native--max-num-vorbis-comments) + (error "Opus user comment list length %s is too long" + last))) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec))) + "Opus comment header specification.") + +(defconst emms-info-native--opus-tags-magic-array + [79 112 117 115 84 97 103 115] + "Opus comment header magic pattern `OpusTags'.") + +;;;; Ogg code + +(defconst emms-info-native--ogg-page-size 65307 + "Maximum size for a single Ogg container page.") + +(defconst emms-info-native--ogg-page-bindat-spec + '((capture-pattern vec 4) + (eval (unless (equal last emms-info-native--ogg-magic-array) + (error "Ogg framing mismatch: expected `%s', got `%s'" + emms-info-native--ogg-magic-array + last))) + (stream-structure-version u8) + (eval (unless (= last 0) + (error ("Ogg version mismatch: expected 0, got %s") + last))) + (header-type-flag u8) + (granule-position vec 8) + (stream-serial-number vec 4) + (page-sequence-no vec 4) + (page-checksum vec 4) + (page-segments u8) + (segment-table vec (page-segments)) + (payload vec (eval (seq-reduce #'+ last 0)))) + "Ogg page structure specification.") + +(defconst emms-info-native--ogg-magic-array + [79 103 103 83] + "Ogg format magic capture pattern `OggS'.") + +(defun emms-info-native--decode-ogg-comments (filename stream-type) + "Read and decode comments from Ogg file FILENAME. +The file is assumed to contain a single stream of type +STREAM-TYPE, which must either `vorbis' or `opus'. + +Return comments in a list of (FIELD . VALUE) cons cells. See +`emms-info-native--split-vorbis-comment' for details." + (let* ((packets (emms-info-native--decode-ogg-packets filename 2)) + (headers (emms-info-native--decode-ogg-headers packets + stream-type)) + (comments (bindat-get-field headers + 'comment-header + 'user-comments))) + (emms-info-native--extract-vorbis-comments comments))) + +(defun emms-info-native--decode-ogg-packets (filename packets) + "Read and decode packets from Ogg file FILENAME. +Read in data from the start of FILENAME, remove Ogg packet +frames, and concatenate payloads until at least PACKETS number of +packets have been decoded. Return the decoded packets in a +vector, concatenated. + +Data is read in `emms-info-native--ogg-page-size' chunks. If the +total length of concatenated packets becomes greater than +`emms-info-native--max-peek-size', an error is signaled. + +Only elementary streams are supported, that is, FILENAME should +contain only a single logical stream. Note that this assumption +is not verified: with non-elementary streams packets from +different streams will be mixed together without an error." + (let ((num-packets 0) + (offset 0) + (stream (vector))) + (while (< num-packets packets) + (let ((page (emms-info-native--decode-ogg-page filename + offset))) + (cl-incf num-packets (or (plist-get page :num-packets) 0)) + (cl-incf offset (plist-get page :num-bytes)) + (setq stream (vconcat stream (plist-get page :stream))) + (when (> (length stream) emms-info-native--max-peek-size) + (error "Ogg payload is too large")))) + stream)) + +(defun emms-info-native--decode-ogg-page (filename offset) + "Read and decode a single Ogg page from FILENAME. +Starting reading data from byte offset OFFSET. + +Return a plist (:num-packets N :num-bytes B :stream S), where N +is the number of packets in the page, B is the size of the page +in bytes, and S is the unframed logical bitstream in a vector. +Note that N can be zero." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename + nil + offset + (+ offset + emms-info-native--ogg-page-size)) + (let* ((page (bindat-unpack emms-info-native--ogg-page-bindat-spec + (buffer-string))) + (num-packets (emms-info-native--num-of-packets page)) + (num-bytes (bindat-length emms-info-native--ogg-page-bindat-spec + page)) + (stream (bindat-get-field page 'payload))) + (list :num-packets num-packets + :num-bytes num-bytes + :stream stream)))) + +(defun emms-info-native--num-of-packets (page) + "Return the number of packets in Ogg page PAGE. +PAGE must correspond to +`emms-info-native--ogg-page-bindat-spec'." + ;; Every element that is less than 255 in the segment table + ;; represents a packet boundary. + (length (seq-filter (lambda (elt) (< elt 255)) + (bindat-get-field page 'segment-table)))) + +(defun emms-info-native--decode-ogg-headers (packets stream-type) + "Decode first two stream headers from PACKETS for STREAM-TYPE. +STREAM-TYPE must be either `vorbis' or `opus'. + +Return a structure that corresponds to either +`emms-info-native--opus-headers-bindat-spec' or +`emms-info-native--vorbis-headers-bindat-spec'." + (cond ((eq stream-type 'vorbis) + (bindat-unpack emms-info-native--vorbis-headers-bindat-spec + packets)) + ((eq stream-type 'opus) + (let (emms-info-native--opus-channel-count) + (bindat-unpack emms-info-native--opus-headers-bindat-spec + packets))) + (t (error "Unknown stream type %s" stream-type)))) + +;;;; FLAC code + +(defconst emms-info-native--flac-metadata-block-header-bindat-spec + '((flags u8) + (length u24) + (eval (when (or (> last emms-info-native--max-peek-size) + (= last 0)) + (error "FLAC block length %s is invalid" last)))) + "FLAC metadata block header specification.") + +(defconst emms-info-native--flac-comment-block-bindat-spec + '((vendor-length u32r) + (eval (when (> last emms-info-native--max-vorbis-vendor-length) + (error "FLAC vendor length %s is too long" last))) + (vendor-string vec (vendor-length)) + (user-comments-list-length u32r) + (eval (when (> last emms-info-native--max-num-vorbis-comments) + (error "FLAC user comment list length %s is too long" + last))) + (user-comments repeat + (user-comments-list-length) + (struct emms-info-native--vorbis-comment-field-bindat-spec))) + "FLAC Vorbis comment block specification.") + +(defun emms-info-native--decode-flac-comments (filename) + "Read and decode comments from FLAC file FILENAME. +Return comments in a list of (FIELD . VALUE) cons cells. Only +FIELDs that are listed in +`emms-info-native--accepted-vorbis-fields' are returned." + (unless (emms-info-native--has-flac-signature filename) + (error "Invalid FLAC stream")) + (let* ((block (emms-info-native--decode-flac-comment-block + filename)) + (unpacked (bindat-unpack emms-info-native--flac-comment-block-bindat-spec + block)) + (user-comments (bindat-get-field unpacked 'user-comments))) + (emms-info-native--extract-vorbis-comments user-comments))) + +(defun emms-info-native--has-flac-signature (filename) + "Check for FLAC stream marker at the beginning of FILENAME. +Return t if there is a valid stream marker, nil otherwise." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 4) + (looking-at "fLaC"))) + +(defun emms-info-native--decode-flac-comment-block (filename) + "Read and decode a comment block from FLAC file FILENAME. +Return the comment block data in a vector." + (with-temp-buffer + (set-buffer-multibyte nil) + (let (comment-block + last-flag + (offset 4)) + (while (and (not comment-block) (not last-flag)) + (insert-file-contents-literally filename + nil + offset + (cl-incf offset 4)) + (let* ((header (bindat-unpack emms-info-native--flac-metadata-block-header-bindat-spec + (buffer-string))) + (end (+ offset (bindat-get-field header 'length))) + (flags (bindat-get-field header 'flags)) + (block-type (logand flags #x7F))) + (setq last-flag (> (logand flags #x80) 0)) + (when (> block-type 6) + (error "FLAC block type error: expected <= 6, got %s" + block-type)) + (when (= block-type 4) + ;; Comment block found, extract it. + (insert-file-contents-literally filename nil offset end t) + (setq comment-block (vconcat (buffer-string)))) + (setq offset end))) + comment-block))) + +;;;; id3v2 (MP3) code + +(defconst emms-info-native--id3v2-header-bindat-spec + '((file-identifier vec 3) + (eval (unless (equal last emms-info-native--id3v2-magic-array) + (error "id3v2 framing mismatch: expected `%s', got `%s'" + emms-info-native--id3v2-magic-array + last))) + (version u8) + (eval (setq emms-info-native--id3v2-version last)) + (revision u8) + (flags bits 1) + (size-bytes vec 4) + (size eval (emms-info-native--checked-id3v2-size 'tag last))) + "id3v2 header specification.") + +(defconst emms-info-native--id3v2-magic-array + [#x49 #x44 #x33] + "id3v2 header magic pattern `ID3'.") + +(defconst emms-info-native--id3v2-frame-header-bindat-spec + '((id str (eval (if (= emms-info-native--id3v2-version 2) 3 4))) + (eval (unless (emms-info-native--valid-id3v2-frame-id-p last) + (error "id3v2 frame id `%s' is invalid" last))) + (size-bytes vec (eval (if (= emms-info-native--id3v2-version 2) 3 4))) + (size eval (emms-info-native--checked-id3v2-size 'frame last)) + (flags bits (eval (if (= emms-info-native--id3v2-version 2) 0 2)))) + "id3v2 frame header specification.") + +(defconst emms-info-native--id3v2-frame-to-info + '(("TAL" . "album") + ("TALB" . "album") + ("TPE2" . "albumartist") + ("TSO2" . "albumartistsort") + ("TSOA" . "albumsort") + ("TP1" . "artist") + ("TPE1" . "artist") + ("TSOP" . "artistsort") + ("TCM" . "composer") + ("TCOM" . "composer") + ("TSOC" . "composersort") + ("TDRC" . "date") + ("TPA" . "discnumber") + ("TPOS" . "discnumber") + ("TCON" . genre) + ("TPUB" . "label") + ("TDOR" . "originaldate") + ("TOR" . "originalyear") + ("TORY" . "originalyear") + ("TIT2" . "title") + ("TT2" . "title") + ("TSOT" . "titlesort") + ("TRK" . "tracknumber") + ("TRCK" . "tracknumber") + ("TYE" . "year") + ("TYER" . "year") + ("TXXX" . user-defined)) + "Mapping from id3v2 frame identifiers to EMMS info fields. + +Sources: + +- URL `https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html' +- URL `http://wiki.hydrogenaud.io/index.php?title=Foobar2000:ID3_Tag_Mapping'") + +(defconst emms-info-native--id3v1-genres + '((0 . "Blues") + (1 . "Classic Rock") + (2 . "Country") + (3 . "Dance") + (4 . "Disco") + (5 . "Funk") + (6 . "Grunge") + (7 . "Hip-Hop") + (8 . "Jazz") + (9 . "Metal") + (10 . "New Age") + (11 . "Oldies") + (12 . "Other") + (13 . "Pop") + (14 . "R&B") + (15 . "Rap") + (16 . "Reggae") + (17 . "Rock") + (18 . "Techno") + (19 . "Industrial") + (20 . "Alternative") + (21 . "Ska") + (22 . "Death Metal") + (23 . "Pranks") + (24 . "Soundtrack") + (25 . "Euro-Techno") + (26 . "Ambient") + (27 . "Trip-Hop") + (28 . "Vocal") + (29 . "Jazz+Funk") + (30 . "Fusion") + (31 . "Trance") + (32 . "Classical") + (33 . "Instrumental") + (34 . "Acid") + (35 . "House") + (36 . "Game") + (37 . "Sound Clip") + (38 . "Gospel") + (39 . "Noise") + (40 . "AlternRock") + (41 . "Bass") + (42 . "Soul") + (43 . "Punk") + (44 . "Space") + (45 . "Meditative") + (46 . "Instrumental Pop") + (47 . "Instrumental Rock") + (48 . "Ethnic") + (49 . "Gothic") + (50 . "Darkwave") + (51 . "Techno-Industrial") + (52 . "Electronic") + (53 . "Pop-Folk") + (54 . "Eurodance") + (55 . "Dream") + (56 . "Southern Rock") + (57 . "Comedy") + (58 . "Cult") + (59 . "Gangsta") + (60 . "Top 40") + (61 . "Christian Rap") + (62 . "Pop/Funk") + (63 . "Jungle") + (64 . "Native American") + (65 . "Cabaret") + (66 . "New Wave") + (67 . "Psychadelic") + (68 . "Rave") + (69 . "Showtunes") + (70 . "Trailer") + (71 . "Lo-Fi") + (72 . "Tribal") + (73 . "Acid Punk") + (74 . "Acid Jazz") + (75 . "Polka") + (76 . "Retro") + (77 . "Musical") + (78 . "Rock & Roll") + (79 . "Hard Rock") + (80 . "Folk") + (81 . "Folk-Rock") + (82 . "National Folk") + (83 . "Swing") + (84 . "Fast Fusion") + (85 . "Bebob") + (86 . "Latin") + (87 . "Revival") + (88 . "Celtic") + (89 . "Bluegrass") + (90 . "Avantgarde") + (91 . "Gothic Rock") + (92 . "Progressive Rock") + (93 . "Psychedelic Rock") + (94 . "Symphonic Rock") + (95 . "Slow Rock") + (96 . "Big Band") + (97 . "Chorus") + (98 . "Easy Listening") + (99 . "Acoustic") + (100 . "Humour") + (101 . "Speech") + (102 . "Chanson") + (103 . "Opera") + (104 . "Chamber Music") + (105 . "Sonata") + (106 . "Symphony") + (107 . "Booty Bass") + (108 . "Primus") + (109 . "Porn Groove") + (110 . "Satire") + (111 . "Slow Jam") + (112 . "Club") + (113 . "Tango") + (114 . "Samba") + (115 . "Folklore") + (116 . "Ballad") + (117 . "Power Ballad") + (118 . "Rhythmic Soul") + (119 . "Freestyle") + (120 . "Duet") + (121 . "Punk Rock") + (122 . "Drum Solo") + (123 . "A cappella") + (124 . "Euro-House") + (125 . "Dance Hall")) + "id3v1 genres.") + +(defconst emms-info-native--id3v2-text-encodings + '((0 . latin-1) + (1 . utf-16) + (2 . uft-16be) + (3 . utf-8)) + "id3v2 text encodings.") + +(defun emms-info-native--valid-id3v2-frame-id-p (id) + "Return t if ID is a proper id3v2 frame identifier, nil otherwise." + (if (= emms-info-native--id3v2-version 2) + (string-match "[A-Z0-9]\\{3\\}" id) + (string-match "[A-Z0-9]\\{4\\}" id))) + +(defun emms-info-native--checked-id3v2-size (elt bytes) + "Calculate id3v2 element ELT size from BYTES. +ELT must be either \\='tag or \\='frame. + +Return the size. Signal an error if the size is zero." + (let ((size (cond ((eq elt 'tag) + (emms-info-native--decode-id3v2-size bytes t)) + ((eq elt 'frame) + (if (= emms-info-native--id3v2-version 4) + (emms-info-native--decode-id3v2-size bytes t) + (emms-info-native--decode-id3v2-size bytes nil)))))) + (if (zerop size) + (error "id3v2 tag/frame size is zero") + size))) + +(defun emms-info-native--decode-id3v2-size (bytes syncsafe) + "Decode id3v2 element size from BYTES. +Depending on SYNCSAFE, BYTES are interpreted as 7- or 8-bit +bytes, MSB first. + +Return the decoded size." + (let ((num-bits (if syncsafe 7 8))) + (apply '+ (seq-map-indexed (lambda (elt idx) + (* (expt 2 (* num-bits idx)) elt)) + (reverse bytes))))) + +(defun emms-info-native--decode-id3v2 (filename) + "Read and decode id3v2 metadata from FILENAME. +Return metadata in a list of (FIELD . VALUE) cons cells, or nil +in case of errors or if there were no known fields in FILENAME. + +See `emms-info-native--id3v2-frame-to-info' for recognized +fields." + (condition-case nil + (let* (emms-info-native--id3v2-version + (header (emms-info-native--decode-id3v2-header filename)) + (tag-size (bindat-get-field header 'size)) + (unsync (memq 7 (bindat-get-field header 'flags))) + (offset 10)) + (when (memq 6 (bindat-get-field header 'flags)) + ;; Skip the extended header. + (cl-incf offset + (emms-info-native--checked-id3v2-ext-header-size filename))) + (emms-info-native--decode-id3v2-frames filename + offset + (+ tag-size 10) + unsync)) + (error nil))) + +(defun emms-info-native--decode-id3v2-header (filename) + "Read and decode id3v2 header from FILENAME." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 10) + (bindat-unpack emms-info-native--id3v2-header-bindat-spec + (buffer-string)))) + +(defun emms-info-native--checked-id3v2-ext-header-size (filename) + "Read and decode id3v2 extended header size from FILENAME. +Return the size. Signal an error if the size is zero." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 10 14) + (emms-info-native--checked-id3v2-size 'frame (buffer-string)))) + +(defun emms-info-native--decode-id3v2-frames (filename begin end unsync) + "Read and decode id3v2 text frames from FILENAME. +BEGIN should be the offset of first byte of the first frame, and +END should be the offset after the complete id3v2 tag. + +If UNSYNC is t, the frames are assumed to have gone through +unsynchronization and decoded as such. + +Return metadata in a list of (FIELD . VALUE) cons cells." + (let ((offset begin) + (limit (- end (emms-info-native--id3v2-frame-header-size))) + comments) + (condition-case nil + (while (< offset limit) + (let* ((frame-data (emms-info-native--decode-id3v2-frame filename + offset + unsync)) + (next-frame-offset (car frame-data)) + (comment (cdr frame-data))) + (when comment (push comment comments)) + (setq offset next-frame-offset))) + (error nil)) + comments)) + +(defun emms-info-native--id3v2-frame-header-size () + "Return the last decoded header size in bytes." + (if (= emms-info-native--id3v2-version 2) 6 10)) + +(defun emms-info-native--decode-id3v2-frame (filename offset unsync) + (let* ((header (emms-info-native--decode-id3v2-frame-header filename + offset)) + (info-id (emms-info-native--id3v2-frame-info-id header)) + (data-offset (car header)) + (size (bindat-get-field (cdr header) 'size))) + (if (or info-id unsync) + ;; Note that if unsync is t, we have to always read the frame + ;; to determine next-frame-offset. + (let* ((data (emms-info-native--read-id3v2-frame-data filename + data-offset + size + unsync)) + (next-frame-offset (car data)) + (value (emms-info-native--decode-id3v2-frame-data (cdr data) + info-id))) + (cons next-frame-offset value)) + ;; Skip the frame. + (cons (+ data-offset size) nil)))) + +(defun emms-info-native--decode-id3v2-frame-header (filename begin) + "Read and decode id3v2 frame header from FILENAME. +Start reading from offset BEGIN. + +Return a cons cell (OFFSET . FRAME), where OFFSET is the byte +offset after the frame header, and FRAME is the decoded frame." + (with-temp-buffer + (set-buffer-multibyte nil) + (let ((end (+ begin (emms-info-native--id3v2-frame-header-size)))) + (insert-file-contents-literally filename nil begin end) + (cons end (bindat-unpack emms-info-native--id3v2-frame-header-bindat-spec + (buffer-string)))))) + +(defun emms-info-native--id3v2-frame-info-id (frame) + "Return the emms-info identifier for FRAME. +If there is no such identifier, return nil." + (cdr (assoc (bindat-get-field frame 'id) + emms-info-native--id3v2-frame-to-info))) + +(defun emms-info-native--read-id3v2-frame-data (filename + begin + num-bytes + unsync) + "Read NUM-BYTES of raw id3v2 frame data from FILENAME. +Start reading from offset BEGIN. If UNSYNC is t, all 'FF 00' +byte combinations are replaced by 'FF'. Replaced byte pairs are +counted as one, instead of two, towards NUM-BYTES. + +Return a cons cell (OFFSET . DATA), where OFFSET is the byte +offset after NUM-BYTES bytes have been read, and DATA is the raw +data." + (with-temp-buffer + (set-buffer-multibyte nil) + (if unsync + ;; Reverse unsynchronization. + (let ((peek-end (+ begin (* 2 num-bytes))) + (end num-bytes)) + (insert-file-contents-literally filename nil begin peek-end) + (goto-char (point-min)) + (while (and (re-search-forward (string 255 0) nil t) + (< (point) end)) + (replace-match (string 255)) + (cl-incf end 1)) + (delete-region (1+ num-bytes) (point-max)) + (cons (+ begin end) (buffer-string))) + ;; No unsynchronization: read the data as-is. + (let ((end (+ begin num-bytes))) + (insert-file-contents-literally filename nil begin end) + (cons end (buffer-string)))))) + +(defun emms-info-native--decode-id3v2-frame-data (data info-id) + "Decode id3v2 text frame data DATA. +If INFO-ID is `user-defined', assume that DATA is a TXXX frame +with key/value-pair. Extract the key and, if it is a mapped +element in `emms-info-native--id3v2-frame-to-info', use it as +INFO-ID. + +If INFO-ID is `genre', assume that DATA is either an integral +id3v1 genre reference or a plain genre string. In the former +case map the reference to a string via +`emms-info-native--id3v1-genres'; in the latter case use the +genre string verbatim. + +Return a cons cell (INFO-ID . VALUE) where VALUE is the decoded +string." + (when info-id + (let ((str (emms-info-native--decode-id3v2-string data))) + (cond ((stringp info-id) (cons info-id str)) + ((eq info-id 'genre) + (if (string-match "^(?\\([0-9]+\\))?" str) + (let ((v1-genre (assoc (string-to-number (match-string 1 str)) + emms-info-native--id3v1-genres))) + (when v1-genre (cons "genre" (cdr v1-genre)))) + (cons "genre" str))) + ((eq info-id 'user-defined) + (let* ((key-val (split-string str (string 0))) + (key (downcase (car key-val))) + (val (cadr key-val))) + (when (rassoc key emms-info-native--id3v2-frame-to-info) + (cons key val)))))))) + +(defun emms-info-native--decode-id3v2-string (bytes) + "Decode id3v2 text information from BYTES. +Remove the terminating null byte, if any. + +Return the text as string." + (let* ((encoding (emms-info-native--id3v2-text-encoding bytes)) + (string (mapconcat #'byte-to-string (seq-rest bytes) "")) + (decoded (decode-coding-string string encoding))) + (when (> (length decoded) 0) + (if (equal (substring decoded -1) "\0") + (substring decoded 0 -1) + decoded)))) + +(defun emms-info-native--id3v2-text-encoding (bytes) + "Return the encoding for text information BYTES." + (cdr (assoc (seq-first bytes) + emms-info-native--id3v2-text-encodings))) + +;;;; EMMS code + +(defun emms-info-native (track) + "Set info fields for TRACK. +Supports Ogg Vorbis/Opus, FLAC, and MP3 files." + (condition-case env + (let* ((filename (emms-track-name track)) + (info-fields (emms-info-native--decode-info-fields filename))) + (dolist (field info-fields) + (let ((name (intern (concat "info-" (car field)))) + (value (cdr field))) + (unless (zerop (length value)) + (emms-track-set track + name + (if (eq name 'info-playing-time) + (string-to-number value) + (string-trim-right value))))))) + (error (message "emms-info-native error processing %s: %s" + (emms-track-name track) env)))) + +(defun emms-info-native--decode-info-fields (filename) + "Decode info fields from FILENAME. +Return a list of (FIELD . VALUE) cons cells, where FIELD is an +info field and VALUE is the corresponding info value. Both are +strings." + (let ((stream-type (emms-info-native--find-stream-type filename))) + (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus)) + (emms-info-native--decode-ogg-comments filename stream-type)) + ((eq stream-type 'flac) + (emms-info-native--decode-flac-comments filename)) + ((eq stream-type 'mp3) + (emms-info-native--decode-id3v2 filename)) + ((eq stream-type 'spc) + (emms-info-spc--decode-id666 filename)) + (t nil)))) + +(defun emms-info-native--find-stream-type (filename) + "Deduce the stream type from FILENAME. +This is a naive implementation that relies solely on filename +extension. + +Return one of symbols `vorbis', `opus', `flac', or `mp3'." + (let ((case-fold-search t)) + (cond ((string-match ".ogg$" filename) 'vorbis) + ((string-match ".opus$" filename) 'opus) + ((string-match ".flac$" filename) 'flac) + ((string-match ".mp3$" filename) 'mp3) + ((string-match ".spc$" filename) 'spc) + (t nil)))) + +(provide 'emms-info-native) + +;;; emms-info-native.el ends here diff --git a/elisp/emms-info-ogginfo.el b/elisp/emms-info-ogginfo.el new file mode 100644 index 0000000..ad8b1b1 --- /dev/null +++ b/elisp/emms-info-ogginfo.el @@ -0,0 +1,83 @@ +;;; emms-info-ogginfo.el --- Emms information from Ogg Vorbis files. -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer +;; Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;; + +;;; Code: + +(require 'emms-info) + +(defgroup emms-info-ogginfo nil + "An EMMS-info method for getting, using the external ogginfo +program" + :group 'emms-info) + +(defcustom emms-info-ogginfo-coding-system 'utf-8 + "Coding system used in the output of ogginfo." + :type 'coding-system) + +(defcustom emms-info-ogginfo-program-name "ogginfo" + "The name/path of the ogginfo tag program." + :type 'string) + +(defun emms-info-ogginfo (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (emms-track-file-p track) + (string-match "\\.[Oo][Gg][Gg]\\'" (emms-track-name track))) + + (with-temp-buffer + (call-process emms-info-ogginfo-program-name + nil t nil (emms-track-name track)) + + ;; play time, emms-info-ogg.el [U. Jensen] + (goto-char (point-min)) + (when (re-search-forward + "Playback length: \\([0-9]*\\)m:\\([0-9]*\\)" nil t) + (let* ((minutes (string-to-number (match-string 1))) + (seconds (string-to-number (match-string 2))) + (ptime-total (+ (* minutes 60) seconds)) + (ptime-min minutes) + (ptime-sec seconds)) + (emms-track-set track 'info-playing-time ptime-total) + (emms-track-set track 'info-playing-time-min ptime-min) + (emms-track-set track 'info-playing-time-sec ptime-sec) + (emms-track-set track 'info-file (emms-track-name track)))) + + ;; all the rest of the info available + (goto-char (point-min)) + (when (re-search-forward "^.*\\.\\.\\.$" (point-max) t) + (while (zerop (forward-line 1)) + (when (looking-at "^\t\\(.*?\\)=\\(.*\\)$") ; recognize the first '=' + (let ((a (match-string 1)) + (b (match-string 2))) + (when (and (< 0 (length a)) + (< 0 (length b) 1024)) + (emms-track-set track + (intern (downcase (concat "info-" (match-string 1)))) + (match-string 2)))))))))) + +(provide 'emms-info-ogginfo) + +;;; emms-info-ogginfo.el ends here diff --git a/elisp/emms-info-opusinfo.el b/elisp/emms-info-opusinfo.el new file mode 100644 index 0000000..7f28387 --- /dev/null +++ b/elisp/emms-info-opusinfo.el @@ -0,0 +1,83 @@ +;;; emms-info-opusinfo.el --- Emms information from Ogg Opus files. -*- lexical-binding: t; -*- + +;; Copyright (C) 2018-2021 Free Software Foundation, Inc. + +;; Author: Pierre Neidhardt + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;; + +;;; Code: + +(require 'emms-info) + +(defgroup emms-info-opusinfo nil + "An EMMS-info method for getting, using the external opusinfo +program" + :group 'emms-info) + +(defcustom emms-info-opusinfo-coding-system 'utf-8 + "Coding system used in the output of opusinfo." + :type 'coding-system) + +(defcustom emms-info-opusinfo-program-name "opusinfo" + "The name/path of the opusinfo tag program." + :type 'string) + +(defun emms-info-opusinfo (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (emms-track-file-p track) + (or (string-match "\\.[Oo][Gg][Gg]\\'" (emms-track-name track)) + (string-match "\\.[Oo][Pp][Uu][Ss]\\'" (emms-track-name track)))) + + (with-temp-buffer + (call-process emms-info-opusinfo-program-name + nil t nil (emms-track-name track)) + + ;; play time + (goto-char (point-min)) + (when (re-search-forward + "Playback length: \\([0-9]*\\)m:\\([0-9]*\\)" nil t) + (let* ((minutes (string-to-number (match-string 1))) + (seconds (string-to-number (match-string 2))) + (ptime-total (+ (* minutes 60) seconds)) + (ptime-min minutes) + (ptime-sec seconds)) + (emms-track-set track 'info-playing-time ptime-total) + (emms-track-set track 'info-playing-time-min ptime-min) + (emms-track-set track 'info-playing-time-sec ptime-sec) + (emms-track-set track 'info-file (emms-track-name track)))) + + ;; all the rest of the info available + (goto-char (point-min)) + (when (re-search-forward "^.*\\.\\.\\.$" (point-max) t) + (while (zerop (forward-line 1)) + (when (looking-at "^\t\\(.*?\\)=\\(.*\\)$") ; recognize the first '=' + (let ((a (match-string 1)) + (b (match-string 2))) + (when (and (< 0 (length a)) + (< 0 (length b))) + (emms-track-set track + (intern (downcase (concat "info-" (match-string 1)))) + (match-string 2)))))))))) + +(provide 'emms-info-opusinfo) + +;;; emms-info-opusinfo.el ends here diff --git a/elisp/emms-info-spc.el b/elisp/emms-info-spc.el new file mode 100644 index 0000000..fd092a5 --- /dev/null +++ b/elisp/emms-info-spc.el @@ -0,0 +1,95 @@ +;;; emms-info-spc.el --- Native Emacs Lisp info method for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Warren Wilkinson + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + +;;; Commentary: + +;; This file provides a native emms-info-method for SPC files. (well, +;; actually the id666 tag embedded inside them). "Native" means a pure +;; Emacs Lisp implementation instead of one relying on external tools +;; or libraries. + +;;; Code: + +(require 'bindat) + +(defconst emms-info-spc--id666-magic-array + [#x53 #x4e #x45 #x53 #x2d #x53 #x50#x43 #x37 #x30 #x30 #x20 #x53 #x6f #x75 #x6e #x64 #x20 #x46 #x69 #x6c #x65 #x20 #x44 #x61 #x74 #x61 #x20 #x76 #x30 #x2e #x33 #x30] + "id666 header magic pattern `SNES-SPC700 Sound File Data v0.30'") + +(defconst emms-info-spc--id666-header-bindat-spec + '((file-identifier vec 33) + (eval (unless (equal last emms-info-spc--id666-magic-array) + (error "id666 framing mismatch: expected `%s', got `%s'" + emms-info-spc--id666-magic-array + last))) + (unused u16) + (has-id666 u8) + (revision u8) + (pc-reg u16) + (a-reg u8) + (x-reg u8) + (y-reg u8) + (psw-reg u8) + (sp-reg u8) + (res-reg u16) + (song-title strz 32) + (game-title strz 32) + (dumper strz 16) + (comment strz 32) + (date strz 11) + (fadeout vec 3) + (fadeout-length vec 5) + (artist strz 32)) + "id666 header specification. + +Sources: + +- URL `https://ocremix.org/info/SPC_Format_Specification' +- URL `https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html'") + +(defun emms-info-spc--decode-id666-header (filename) + "Read and decode id666 header from FILENAME." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 210) + (bindat-unpack emms-info-spc--id666-header-bindat-spec + (buffer-string)))) + +(defun emms-info-spc--decode-id666 (filename) + "Read and decode id666 metadata from FILENAME. +Return metadata in a list of (FIELD . VALUE) cons cells, or nil +in case of errors or if there were no known fields in FILENAME." + (condition-case nil + (let ((header (emms-info-spc--decode-id666-header filename))) + (when (= 26 (bindat-get-field header 'has-id666)) + (list + (cons 'info-title (bindat-get-field header 'song-title)) + (cons 'info-album (bindat-get-field header 'game-title)) + (cons 'info-artist (bindat-get-field header 'artist)) + (cons 'info-composer (bindat-get-field header 'artist)) + (cons 'info-note (bindat-get-field header 'comment))))) + (error nil))) + +(provide 'emms-info-spc) + +;;; emms-info-spc.el ends here diff --git a/elisp/emms-info-tinytag.el b/elisp/emms-info-tinytag.el new file mode 100644 index 0000000..28a72de --- /dev/null +++ b/elisp/emms-info-tinytag.el @@ -0,0 +1,117 @@ +;;; emms-info-tinytag.el --- Info-method for EMMS using tinytag -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. + +;; Author: Fran Burstall +;; Keywords: multimedia + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING.. If not, see +;; . + +;;; Commentary: + +;; This code has been adapted from code found in emms-info-libtag.el, +;; written by Ulrik Jensen and Jorgen Schäfer +;; . + +;; To activate this method for getting info, use: + +;; (require 'emms-info-tinytag) +;; (add-to-list 'emms-info-functions 'emms-info-tinytag) + +;; Note that you should remove emms-info-mp3info and emms-info-ogginfo +;; from the emms-info-functions list if you want to avoid +;; conflicts. For example, to set tinytag as your exclusive info +;; provider: + +;; (setq emms-info-functions '(emms-info-tinytag)) + +;; To use this provider, you need to install the tinytag python module +;; with something like: + +;; pip install tinytag + +;;; Code: + +(require 'emms-info) +(require 'json) ;see below + +(defgroup emms-info-tinytag nil + "Options for EMMS." + :group 'emms-info) + +(defvar emms-info-tinytag-coding-system 'utf-8) ;is this used anywhere? + +(defcustom emms-info-tinytag-python-name "python" + "Name of python we use." + :type '(string)) + +(defcustom emms-info-tinytag-known-extensions + (regexp-opt '("mp3" "mp4" "m4a" "m4b" "ogg" "opus" "flac" "wma" "wav")) + "Regexp of known extensions that `emms-info-tinytag' can handle. + +Case is irrelevant." + :type '(string)) + +(defvar emms-info-tinytag--info-fields + '((info-album . album) + (info-albumartist . albumartist) + (info-artist . artist) + (info-composer . composer) + (info-year . year) + (info-discnumber . disc) + (info-genre . genre) + (info-note . comment) + (info-playing-time . duration) + (info-title . title) + (info-tracknumber . track)) + "An alist mapping info-* fields to tinytag fields.") + +(defun emms-info-tinytag (track) + "Set tags for TRACK using tinytag." + (when (and (emms-track-file-p track) + (let ((case-fold-search t)) + (string-match + emms-info-tinytag-known-extensions + (emms-track-name track)))) + (with-temp-buffer + (when (zerop + (let ((coding-system-for-read 'utf-8)) + (call-process emms-info-tinytag-python-name + nil '(t nil) nil + "-m" "tinytag" (emms-track-name track)))) + (goto-char (point-min)) + ;; tinytag can output json or [ct]sv. Sadly, in the latter + ;; case, null values are unhelpfully represented by the string + ;; "None" so we parse the json. + (let ((track-info (json-read))) + (dolist (field emms-info-tinytag--info-fields) + (let ((name (car field)) + (value (alist-get (cdr field) track-info))) + (when (and value (or (numberp value) (> (length value) + 0))) + (emms-track-set track + name + (cond ((eq name 'info-playing-time) + (round value)) + ;; for m4a, disc or track is an int: issue raised upstream + ((and (or (eq name 'info-discnumber) + (eq name 'info-tracknumber)) + (numberp value)) + (number-to-string value)) + (t value))))))))))) + +(provide 'emms-info-tinytag) + +;;; emms-info-tinytag.el ends here diff --git a/elisp/emms-info.el b/elisp/emms-info.el new file mode 100644 index 0000000..a180c3a --- /dev/null +++ b/elisp/emms-info.el @@ -0,0 +1,138 @@ +;;; emms-info.el --- Retrieving track information -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301, USA. + +;;; Commentary: + +;; This EMMS module provides a way to add information for a track. +;; This can use an ID3 or OGG comment like syntax. + +;; The code will add info symbols to the track. The following symbols +;; are defined: + +;; info-artist - string naming the artist +;; info-composer - string naming the composer +;; info-performer - string naming the performer +;; info-title - string naming the title of the song +;; info-album - string naming the album +;; info-tracknumber - string(?) naming the track number +;; info-discnumber - string naming the disc number +;; info-year - string naming the year +;; info-note - string of free-form entry +;; info-genre - string naming the genre +;; info-playing-time - number giving the seconds of playtime + +;;; Code: + +(require 'emms) +(require 'emms-later-do) + +(defgroup emms-info nil + "*Track information. ID3, OGG, etc." + :group 'emms) + +(defcustom emms-info-auto-update t + "Non-nil when EMMS should update track information if the file changes. +This will cause hard drive activity on track loading. If this is +too annoying for you, set this variable to nil." + :type 'boolean) + +(defcustom emms-info-asynchronously t + "Non-nil when track information should be loaded asynchronously." + :type 'boolean) + +(defcustom emms-info-report-each-num-tracks 200 + "Non-zero will report progress information every number of tracks. +The default is to display a message every 200 tracks. +This variable is only used when adding tracks asynchronously." + :type 'integer) + +(defcustom emms-info-functions nil + "Functions which add information to tracks. +Each is called with a track as argument." + :type 'hook) + +(defvar emms-info-asynchronous-tracks 0 + "Number of tracks we're waiting for to be done.") + +(defun emms-info-initialize-track (track &optional force) + "Initialize TRACK with emms-info information. +Update TRACK information if it is new or has been modified since +last update, or if FORCE is non-nil. + +This is a suitable value for `emms-track-initialize-functions'." + (if (not emms-info-asynchronously) + (emms-info-really-initialize-track track force) + (setq emms-info-asynchronous-tracks (1+ emms-info-asynchronous-tracks)) + (emms-later-do 'emms-info-really-initialize-track track force))) + +(defun emms-info-really-initialize-track (track &optional force) + "Really initialize TRACK. +Return t when the track got changed." + (let ((file-mtime (when emms-info-auto-update + (emms-info-track-file-mtime track))) + (info-mtime (emms-track-get track 'info-mtime))) + + ;; if the file's been modified or is new + (when (or (not file-mtime) + (not info-mtime) + (emms-time-less-p info-mtime file-mtime) + force) + (run-hook-with-args 'emms-info-functions track) + ;; not set by info functions + (when file-mtime + (emms-track-set track 'info-mtime file-mtime)) + (emms-track-updated track)) + + (when emms-info-asynchronously + (setq emms-info-asynchronous-tracks (1- emms-info-asynchronous-tracks)) + (if (zerop emms-info-asynchronous-tracks) + (message "EMMS: All track information loaded.") + (unless (zerop emms-info-report-each-num-tracks) + (if (zerop + (mod emms-info-asynchronous-tracks + emms-info-report-each-num-tracks)) + (message "EMMS: %d tracks to go.." + emms-info-asynchronous-tracks))))))) + +(defun emms-info-track-file-mtime (track) + "Return the mtime of the file of TRACK, if any. +Return nil otherwise." + (if (eq (emms-track-type track) + 'file) + (nth 5 (file-attributes (emms-track-name track))) + nil)) + +(defun emms-info-track-description (track) + "Return a description of TRACK." + (let ((artist (emms-track-get track 'info-artist)) + (title (emms-track-get track 'info-title))) + (cond + ((and artist title) + (concat artist " - " title)) + (title + title) + (t + (emms-track-simple-description track))))) + +(provide 'emms-info) +;;; emms-info.el ends here diff --git a/elisp/emms-jack.el b/elisp/emms-jack.el new file mode 100644 index 0000000..3a46ced --- /dev/null +++ b/elisp/emms-jack.el @@ -0,0 +1,359 @@ +;;; emms-jack.el --- Jack Audio Connection Kit support -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: multimedia, processes + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; JACK is a low-latency audio server, written for POSIX conformant +;; operating systems such as GNU/Linux and Apple's OS X. It can connect a +;; number of different applications to an audio device, as well as +;; allowing them to share audio between themselves. Its clients can run in +;; their own processes (ie. as normal applications), or they can run +;; within the JACK server (ie. as a "plugin"). +;; +;; JACK was designed from the ground up for professional audio work, and +;; its design focuses on two key areas: synchronous execution of all +;; clients, and low latency operation. +;; +;; jack.el provides a fascility for starting jackd from within Emacs. +;; It also povides convenience functions for prompting the user for +;; jack client and port names in the minibuffer, as well as the +;; functions `jack-connect' and `jack-disconnect' which can be used to +;; rearrange jack port wiring with a minimum of keystrokes. + +;;; Code: + +(require 'emms-compat) + +(defgroup emms-jack () + "Jack Audio Connection Kit" + :group 'processes) + +(defcustom emms-jack-rc '("~/.jackdrc" "/etc/jackd.conf") + "JACK run control paths." + :type 'repeat) + +(defcustom emms-jack-use-jack-rc t + "If non-nil, try to retrieve jack startup arguments from run control files +listed in `jack-rc'. If no rc file is found or this variable is set +to nil, use the Emacs variables to build the startup args." + :type 'boolean) + +(defcustom emms-jack-program (executable-find "jackd") + "JACK executable path." + :type 'file) + +(defcustom emms-jack-sample-rate 44100 + "Default sampling rate for JACK." + :type 'integer) + +(defcustom emms-jack-period-size 128 + "Period size to use when launching new JACK process." + :type 'integer) + +(defcustom emms-jack-alsa-device nil + "ALSA soundcard to use." + :type '(choice (const :tag "Ask" nil) string)) + +(defun emms-jack-read-alsa-device () + "Read an ALSA device name using the minibuffer." + (let (cards) + (with-temp-buffer + (insert-file-contents "/proc/asound/cards") + (while (not (eobp)) + (if (looking-at "^\\([0-9]\\) \\[.+\\]: \\(.+\\)\n +\\(.*\\)$") + (setq cards (append (list (cons (match-string 3) (match-string 1))) cards))) + (forward-line 1))) + (concat "hw:" (cdr (assoc (completing-read "Card: " cards nil t) cards))))) + +(defun emms-jack-alsa-device () + (or emms-jack-alsa-device (emms-jack-read-alsa-device))) + +(defcustom emms-jack-output-buffer-name "*JACK output*" + "Output buffer name." + :type 'string) + +(defun emms-jack-args () + "Return a list of startup arguments to use. +First element is the executable path." + (or (and emms-jack-use-jack-rc + (catch 'rc-found + (let ((files (mapcar #'expand-file-name emms-jack-rc))) + (while files + (if (file-exists-p (car files)) + (with-temp-buffer + (insert-file-contents (car files)) + (when (> (buffer-size) 0) + (throw 'rc-found + (split-string (buffer-string) "[\n \t]+"))))) + (setq files (cdr files)))) + nil)) + (list emms-jack-program + "-v" + "-R" + "-dalsa" + (format "-d%s" (emms-jack-alsa-device)) + (format "-r%d" emms-jack-sample-rate) + (format "-p%d" emms-jack-period-size)))) + +(defcustom emms-jack-set-rtlimits t + "Use set_rtlimits (if available) to gain realtime priorities if -R +is given in jackd command-line." + :type 'boolean) + +(defcustom emms-jack-set-rtlimits-program (executable-find "set_rtlimits") + "Path to set_rtlimits." + :type 'file) + +(defun emms-jack-maybe-rtlimits (args) + (if (and emms-jack-set-rtlimits + (or (member "-R" args) (member "--realtime" args)) + (file-exists-p emms-jack-set-rtlimits-program)) + (append (list emms-jack-set-rtlimits-program "-r") args) + args)) + +(defvar emms-jack-process nil) + +(defvar emms-jack-load 0) + +(defvar emms-jack-max-usecs 0) + +(defvar emms-jack-spare 0) + +(defun emms-jack-output-buffer () + (or (get-buffer emms-jack-output-buffer-name) + (with-current-buffer (get-buffer-create emms-jack-output-buffer-name) + (setq major-mode 'emms-jack-mode + mode-name "JACK" + mode-line-format (copy-tree mode-line-format)) + (setcar (nthcdr 16 mode-line-format) + `(:eval (format "load:%.2f" emms-jack-load))) + (add-hook 'kill-buffer-hook #'emms-jack-kill nil t) + (current-buffer)))) + +(defvar emms-jack-xruns nil) + +(defun emms-jack-filter (proc string) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + (save-match-data + (if (string-match "^load = \\([^ ]+\\) max usecs: \\([^,]+\\), spare = \\(.+\\)$" string) + (setq emms-jack-load (string-to-number (match-string 1 string)) + emms-jack-max-usecs (string-to-number (match-string 2 string)) + emms-jack-spare (string-to-number (match-string 3 string))) + (if (string-match "^**** alsa_pcm: xrun of at least \\([^ ]+\\) msecs$" string) + (push (string-to-number (match-string 1 string)) emms-jack-xruns) + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point)))))) + (when moving (goto-char (process-mark proc)))))) + +(defun emms-jack-running-p () + (and emms-jack-process (processp emms-jack-process) + (eq (process-status emms-jack-process) 'run))) + +(defcustom emms-jack-started-hook nil + "Hook run when `emms-jack-start' successfully started a new JACK intance." + :type 'hook) + +(defun emms-jack-start () + "Start the JACK process." + (interactive) + (if (emms-jack-running-p) (error "JACK already running") + (setq emms-jack-process + (apply #'start-process "jack" (emms-jack-output-buffer) + (emms-jack-maybe-rtlimits (emms-jack-args)))) + (set-process-filter emms-jack-process #'emms-jack-filter) + (run-hooks 'emms-jack-started-hook) + (switch-to-buffer (emms-jack-output-buffer)))) + +(defun emms-jack-kill () + "Kill the currently running JACK process." + (interactive) + (when (emms-jack-running-p) (delete-process emms-jack-process)) + (setq emms-jack-process nil)) + +(defun emms-jack-restart () + "Restart JACK." + (interactive) + (if (emms-jack-running-p) (emms-jack-kill)) + (sit-for 0) + (emms-jack-start)) + +(defun emms-jack-list () + "Retrieve a list of JACK clients/ports." + (with-temp-buffer + (call-process "jack_lsp" nil t nil "-cpl") + (goto-char (point-min)) + (let (result current-port) + (while (not (eobp)) + (cond + ((looking-at "^\\([^ \t:]+\\):\\(.+\\)$") + (let ((program (match-string 1)) + (port (match-string 2))) + (if (assoc program result) + (setcdr (assoc program result) + (append (cdr (assoc program result)) (list (setq current-port (list port))))) + (setq result + (append (list (list program (setq current-port (list port)))) result))))) + ((looking-at "^ \\([^ \t:]+\\):\\(.+\\)$") + (if (assoc 'connections (cdr current-port)) + (setcdr (assoc 'connections (cdr current-port)) + (append (cdr (assoc 'connections current-port)) + (list (list (match-string 1) (match-string 2))))) + (setcdr current-port + (append (list (list 'connections (list (match-string 1) (match-string 2)))) (cdr current-port))))) + ((looking-at "^\tproperties: \\(.+\\),$") + (setcdr current-port + (append (list (append (list 'properties) (mapcar #'intern (split-string (match-string 1) ",")))) (cdr current-port))))) + (forward-line 1)) + result))) + +(defun emms-jack-ports (program) + (cdr (assoc program (emms-jack-list)))) + +(defun emms-jack-get-port-connections (program port) + (cdr (assoc 'connections (cdr (assoc port (emms-jack-ports program)))))) + +(defun emms-jack-get-port-properties (program port) + (cdr (assoc 'properties (cdr (assoc port (emms-jack-ports program)))))) + +(defun emms-jack-get-direction (program port) + (let ((props (emms-jack-get-port-properties program port))) + (or (car (member 'output props)) + (car (member 'input props)) + (error "Neither input nor output port")))) + +(defun emms-jack-read-program (prompt &optional predicate) + (let ((progs (if (functionp predicate) + (emms-remove-if-not predicate (emms-jack-list)) + (emms-jack-list)))) + (unless progs (error "No matching JACK clients found")) + (if (< (length progs) 2) (caar progs) + (completing-read prompt progs nil t)))) + +(defun emms-jack-unique-port-name (strings) + (let ((start "") + (maxlen (apply #'min (mapcar #'length strings)))) + (while (and (< (length start) maxlen) + (catch 'not-ok + (let ((nextchar (substring (car strings) (length start) (1+ (length start))))) + (mapc (lambda (str) + (unless (string= (concat start nextchar) (substring str 0 (1+ (length start)))) + (throw 'not-ok nil))) + strings) + t))) + (setq start (substring (car strings) 0 (1+ (length start))))) + start)) + +(defun emms-jack-read-port (program prompt &optional predicate) + (let ((ports (if (functionp predicate) + (emms-remove-if-not predicate (emms-jack-ports program)) + (emms-jack-ports program)))) + (if (< (length ports) 2) (caar ports) + (completing-read prompt ports nil t + (emms-jack-unique-port-name (mapcar #'car ports)))))) + +(defun emms-jack-connect (from-program from-port to-program to-port) + "Connect FROM-PROGRAM's output port FROM-PORT to TO-PROGRAM's input port +TO-PORT. +If called interactively, the direction does not matter." + (interactive + (let* ((prog (emms-jack-read-program "Connect: ")) + (port (emms-jack-read-port prog (format "Connect %s port: " prog))) + (to-type (if (eq (emms-jack-get-direction prog port) 'input) 'output 'input)) + (to-prog (emms-jack-read-program + (format "Connect %s port %s to: " prog port) + (lambda (prog) + (emms-find-if (lambda (port) + (member to-type (assoc 'properties + (cdr port)))) + (cdr prog))))) + (to-port (emms-jack-read-port + to-prog + (format "Connect %s port %s to %s port: " prog port to-prog) + (lambda (port) + (member to-type (cdr (assoc 'properties (cdr port)))))))) + (if (eq to-type 'input) + (list prog port to-prog to-port) + (list to-prog to-port prog port)))) + (let ((result (call-process "jack_connect" nil nil nil + (format "%s:%s" from-program from-port) + (format "%s:%s" to-program to-port)))) + (if (= result 0) + (message "JACK: Connected %s:%s to %s:%s" + from-program from-port to-program to-port)))) + +(defun emms-jack-disconnect (from-program from-port to-program to-port) + "Disconnect FROM-PROGRAM's output port FROM-PORT from TO-PROGRAM's +input port TO-PORT. +If called interactively, the direction is not relevant." + (interactive + (let* ((prog (emms-jack-read-program + "Disconnect: " + (lambda (prog) + (emms-find-if (lambda (port) (assoc 'connections (cdr port))) + (cdr prog))))) + (port (emms-jack-read-port prog + (format "Disconnect %s port: " prog) + (lambda (port) + (assoc 'connections (cdr port))))) + (connections (emms-jack-get-port-connections prog port)) + (from (list prog port)) + (to (if (< (length connections) 2) + (car connections) + (let* ((to-progs (let (result) + (mapc (lambda (conn) + (if (not (member (car conn) result)) + (setq result + (append (list (car conn)) + result)))) + connections) + (mapcar #'list result))) + (to-prog (if (< (length to-progs) 2) + (caar to-progs) + (completing-read + (format "Disconnect %s port %s from: " + prog port) to-progs nil t)))) + (setq connections (emms-remove-if-not + (lambda (conn) + (string= (car conn) to-prog)) + connections)) + (if (< (length connections) 2) + (car connections) + (let ((to-port (completing-read + (format "Disconnect %s port %s from %s port: " + prog port to-prog) + (mapcar #'cdr connections) nil t))) + (list to-prog to-port))))))) + (if (eq (emms-jack-get-direction prog port) 'output) + (append from to) + (append to from)))) + (let ((result (call-process "jack_disconnect" nil nil nil + (format "%s:%s" from-program from-port) + (format "%s:%s" to-program to-port)))) + (if (= result 0) + (message "JACK: Disconnected %s:%s from %s:%s" + from-program from-port to-program to-port)))) + +(provide 'emms-jack) +;;; emms-jack.el ends here diff --git a/elisp/emms-last-played.el b/elisp/emms-last-played.el new file mode 100644 index 0000000..679e98a --- /dev/null +++ b/elisp/emms-last-played.el @@ -0,0 +1,123 @@ +;;; emms-last-played.el --- Support for last-played-time of a track -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. + +;; Author: Lucas Bonnet +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Records when the track was last played. +;; Big portions of the time handling fuctions are copied from +;; gnus-util.el, and slightly adapted. + +;;; Code: + +(require 'emms) + +(defvar emms-last-played-keep-count t + "Specifies if EMMS should record the number of times you play a track. +Set it to t if you want such a feature, and to nil if you don't.") + +(defvar emms-last-played-format-alist + '(((emms-last-played-seconds-today) . "%k:%M") + (604800 . "%a %k:%M") ;;that's one week + ((emms-last-played-seconds-month) . "%a %d") + ((emms-last-played-seconds-year) . "%b %d") + (t . "%b %d '%y")) ;;this one is used when no + ;;other does match + "Specifies date format depending on when a track was last played. +This is an alist of items (AGE . FORMAT). AGE can be a number (of +seconds) or a Lisp expression evaluating to a number. When the age of +the track is less than this number, then use `format-time-string' +with the corresponding FORMAT for displaying the date of the track. +If AGE is not a number or a Lisp expression evaluating to a +non-number, then the corresponding FORMAT is used as a default value. + +Note that the list is processed from the beginning, so it should be +sorted by ascending AGE. Also note that items following the first +non-number AGE will be ignored. + +You can use the functions `emms-last-played-seconds-today', +`emms-last-played-seconds-month' and +`emms-last-played-seconds-year' in the AGE spec. They return the +number of seconds passed since the start of today, of this month, +of this year, respectively.") + + +(defun emms-last-played-update-track (track) + "Updates the last-played time of TRACK." + (emms-track-set track 'last-played (current-time))) + +(defun emms-last-played-increment-count (track) + "Increments the play-count property of TRACK. +If non-existent, it is set to 1." + (let ((play-count (emms-track-get track 'play-count))) + (if play-count + (emms-track-set track 'play-count (1+ play-count)) + (emms-track-set track 'play-count 1)))) + +(defun emms-last-played-update-current () + "Updates the current track." + (emms-last-played-update-track (emms-playlist-current-selected-track)) + (if emms-last-played-keep-count + (emms-last-played-increment-count (emms-playlist-current-selected-track)))) + +(defun emms-last-played-seconds-today () + "Return the number of seconds passed today." + (let ((now (decode-time (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) + +(defun emms-last-played-seconds-month () + "Return the number of seconds passed this month." + (let ((now (decode-time (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) + (* (- (car (nthcdr 3 now)) 1) 3600 24)))) + +(defun emms-last-played-seconds-year () + "Return the number of seconds passed this year." + (let ((now (decode-time (current-time))) + (days (format-time-string "%j" (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) + (* (- (string-to-number days) 1) 3600 24)))) + +(defun emms-last-played-format-date (messy-date) + "Format the messy-date according to `emms-last-played-format-alist'. +Returns \" ? \" if there's bad input or if an other error occurs. +Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." + (condition-case () + (let* ((messy-date (float-time messy-date)) + (now (float-time (current-time))) + ;;If we don't find something suitable we'll use this one + (my-format "%b %d '%y")) + (let* ((difference (- now messy-date)) + (templist emms-last-played-format-alist) + (top (eval (caar templist) t))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist) t)))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format t) (seconds-to-time messy-date))) + (error "Never."))) + +(provide 'emms-last-played) +;;; emms-last-played.el ends here diff --git a/elisp/emms-later-do.el b/elisp/emms-later-do.el new file mode 100644 index 0000000..d41d8b1 --- /dev/null +++ b/elisp/emms-later-do.el @@ -0,0 +1,86 @@ +;;; emms-later-do.el --- Execute Lisp code ... later -*- lexical-binding: t; -*- + +;; Copyright (C) 2004-2021 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; This program 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary + +;; This file will execute lisp code ``later on''. This way it is +;; possible to work while elisp does some longer calculations, if you +;; can convert those calculations into a sequence of function calls. + +;; 2020-09-22: Name changed from later-do to emms-later-do in order to +;; avoid polluting the namespace. + +;;; Code: + +(defvar emms-later-do-version "0.2emms4 (2018-04-07)" + "Version string of emms-later-do.") + +(defgroup emms-later-do nil + "*Running functions ... later!" + :prefix "emms-later-do-" + :group 'development) + +(defcustom emms-later-do-interval 0.5 + "How many seconds to wait between running events." + :type 'number) + +(defcustom emms-later-do-batch 20 + "How many functions to process before waiting `emms-later-do-interval'. +The functions are processed from `emms-later-do-list'. Must be 1 or +greater. Too high a value might make Emacs slower while the +list is being processed." + :type 'number) + +(defvar emms-later-do-list nil + "A list of functions to be called later on.") + +(defvar emms-later-do-timer nil + "The timer that emms-later-do uses.") + +(defun emms-later-do (function &rest args) + "Apply FUNCTION to ARGS later on. This is an unspecified +amount of time after this call, and definitely not while lisp is +still executing. Code added using `emms-later-do' is guaranteed to be +executed in the sequence it was added." + (setq emms-later-do-list (nconc emms-later-do-list + (list (cons function args)))) + (unless emms-later-do-timer + (setq emms-later-do-timer + (run-with-timer emms-later-do-interval nil 'emms-later-do-timer)))) + +(defun emms-later-do-timer () + "Run the next element in `emms-later-do-list', or do nothing if it's +empty." + (if (null emms-later-do-list) + (setq emms-later-do-timer nil) + (let (res) + (unwind-protect + (dotimes (_b (min emms-later-do-batch (length emms-later-do-list)) res) + (let ((fun (caar emms-later-do-list)) + (args (cdar emms-later-do-list))) + (setq emms-later-do-list (cdr emms-later-do-list)) + (setq res (apply fun args))))) + (setq emms-later-do-timer (run-with-timer emms-later-do-interval + nil + 'emms-later-do-timer))))) + +(provide 'emms-later-do) +;;; emms-later-do.el ends here diff --git a/elisp/emms-librefm-scrobbler.el b/elisp/emms-librefm-scrobbler.el new file mode 100644 index 0000000..ebb6aed --- /dev/null +++ b/elisp/emms-librefm-scrobbler.el @@ -0,0 +1,333 @@ +;;; emms-librefm-scrobbler.el --- Libre.FM Scrobbing API -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; Keywords: emms, libre.fm, GNU FM + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public +;; License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + +;;; Commentary: + +;; To use libre.fm you need to add username and password to +;; ~/.authinfo.gpg or an equivalent file understood by auth-source. +;; To enable scrobbling call (emms-librefm-scrobbler-enable). + +;;; Code: + +(require 'emms-playing-time) +(require 'auth-source) +(require 'url-vars) + + +(defvar emms-librefm-scrobbler-handshake-url + "turtle.libre.fm" + "Endpoint for client handshake.") + +(defvar emms-librefm-scrobbler-method + "https" + "Transfer method.") + +(defvar emms-librefm-scrobbler-username nil + "Libre.fm username. + +Note that the preferred way of authenticating is using authinfo +and only setting `emms-librefm-scrobbler-handshake-url'. See the +manual for details.") + +(defvar emms-librefm-scrobbler-password nil + "Libre.fm user password. + +Note that the preferred way of authenticating is using authinfo. +See also `emms-librefm-scrobbler-username'.") + +(defvar emms-librefm-scrobbler-debug + "" + "Debugging variable to store communication.") + +(defvar emms-librefm-scrobbler-session-id + nil + "Session ID for Libre.fm.") + +(defvar emms-librefm-scrobbler-now-playing-url + "" + "URL for getting the track playing.") + +(defvar emms-librefm-scrobbler-submission-url + "" + "URL for submissions.") + +(defvar emms-librefm-scrobbler-track-play-start-timestamp + nil + "Time when a track started playing.") + +(defvar emms-librefm-scrobbler-display-submissions + t + "Whether to display a user message on every submission.") + + +;;; ------------------------------------------------------------------ +;;; authenticate +;;; ------------------------------------------------------------------ +(defun emms-librefm-scrobbler--get-auth-detail (token) + "Return TOKEN from auth-source. +TOKEN is :user of :secret." + ;; TODO: Maybe we should enable :create t here. But it could be + ;; kind of annoying as it makes a pop-up when no name is present. + (plist-get + (car (auth-source-search :host (list emms-librefm-scrobbler-handshake-url "libre.fm") + :user (unless (equal emms-librefm-scrobbler-username "") + emms-librefm-scrobbler-username) + :max 1 :require '(:user :secret))) + token)) + +(defun emms-librefm-scrobbler--username () + "Return username for libre.fm." + (or (emms-librefm-scrobbler--get-auth-detail :user) + emms-librefm-scrobbler-username)) + +(defun emms-librefm-scrobbler--password () + "Return password for libre.fm." + (let ((token (emms-librefm-scrobbler--get-auth-detail :secret))) + (cond ((functionp token) (funcall token)) + ((characterp token) token) + (t emms-librefm-scrobbler-password)))) + +;;; ------------------------------------------------------------------ +;;; handshake +;;; ------------------------------------------------------------------ + +(defun emms-librefm-scrobbler-handshake-string (url username password) + "Return the client handshake string." + (when (= 0 (length url)) + (error "bad url")) + (when (= 0 (length username)) + (error "bad username")) + (when (= 0 (length password)) + (error "bad password")) + (let ((timestamp (format-time-string "%s"))) + (concat emms-librefm-scrobbler-method + "://" + url "/?" + "hs=true" "&" + "p=1.2" "&" + "c=emm" "&" + "v=1.0" "&" + "u=" (url-encode-url username) "&" + "t=" timestamp "&" + "a=" (md5 (concat (md5 password) timestamp))))) + +(defun emms-librefm-scrobbler-handshake-call (url username password) + "Perform client handshake and return a response in a buffer." + (let ((url-request-method "POST")) + (ignore url-request-method) + (let ((response + (url-retrieve-synchronously + (emms-librefm-scrobbler-handshake-string + url username password)))) + (setq emms-librefm-scrobbler-debug + (with-current-buffer response + (buffer-substring-no-properties (point-min) + (point-max)))) + response))) + +(defun emms-librefm-scrobbler-handle-handshake-response (resbuf) + "Handle the client handshake server response." + (when (not (bufferp resbuf)) + (error "response not a buffer")) + (with-current-buffer resbuf + (goto-char (point-min)) + (when (not (re-search-forward "^.*200 OK$" (line-end-position) t)) + (error "bad HTTP server response")) + ;; go to the start of the FM response + (when (not (re-search-forward "\n\n" (point-max) t)) + (error "bad FM server response")) + (let ((status (buffer-substring (line-beginning-position) + (line-end-position)))) + (when (not (string= status "OK")) + (error "FM server returned: %s" status)) + (let (session-id + now-playing-url + submission-url) + (forward-line 1) + (setq session-id (buffer-substring (line-beginning-position) + (line-end-position))) + (forward-line 1) + (setq now-playing-url (buffer-substring (line-beginning-position) + (line-end-position))) + (forward-line 1) + (setq submission-url (buffer-substring (line-beginning-position) + (line-end-position))) + (when (or (= 0 (length session-id)) + (= 0 (length now-playing-url)) + (= 0 (length submission-url))) + (error "couldn't parse FM server response")) + (setq emms-librefm-scrobbler-session-id session-id + emms-librefm-scrobbler-now-playing-url now-playing-url + emms-librefm-scrobbler-submission-url submission-url) + (message "handshake successful"))))) + +(defun emms-librefm-scrobbler-handshake () + "Perform client handshake call and handle response." + (emms-librefm-scrobbler-handle-handshake-response + (emms-librefm-scrobbler-handshake-call + emms-librefm-scrobbler-handshake-url + (emms-librefm-scrobbler--username) + (emms-librefm-scrobbler--password)))) + + +;;; ------------------------------------------------------------------ +;;; submission +;;; ------------------------------------------------------------------ + +(defun emms-librefm-scrobbler-make-query (track rating) + "Format the url parameters for scrobbling." + (setq rating + (cond ((equal 'love rating) "L") + ((equal 'ban rating) "B") + ((equal 'skip rating) "S") + (t ""))) + (let ((artist (emms-track-get track 'info-artist)) + (title (emms-track-get track 'info-title)) + (album (or (emms-track-get track 'info-album) "")) + (track-number (emms-track-get track 'info-tracknumber)) + (musicbrainz-id "") + (track-length (number-to-string + (or (emms-track-get track + 'info-playing-time) + 0)))) + (if (and artist title) + (concat + "s=" emms-librefm-scrobbler-session-id + "&a[0]=" (url-encode-url artist) + "&t[0]=" (url-encode-url title) + "&i[0]=" (url-encode-url + (or emms-librefm-scrobbler-track-play-start-timestamp + (format-time-string "%s"))) + "&o[0]=" "P" + "&r[0]=" (url-encode-url rating) + "&l[0]=" track-length + "&b[0]=" (url-encode-url album) + "&n[0]=" track-number + "&m[0]=" musicbrainz-id) + (error "Track title and artist must be known.")))) + + +;;; ------------------------------------------------------------------ +;;; asynchronous submission +;;; ------------------------------------------------------------------ + +(defun emms-librefm-scrobbler-get-response-status () + "Check the HTTP header and return the body." + (let ((ok200 "HTTP/1.1 200 OK")) + (if (< (point-max) 1) + (error "No response from submission server")) + (if (not (string= ok200 (buffer-substring-no-properties (point-min) 16))) + (error "submission server not responding correctly")) + (goto-char (point-min)) + (re-search-forward "\n\n") + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + +(defun emms-librefm-scrobbler-make-async-submission-call (track rating) + "Make asynchronous submission call." + (let ((flarb (emms-librefm-scrobbler-make-query track rating))) + (let* ((url-request-method "POST") + (url-request-data flarb) + (url-request-extra-headers + `(("Content-type" . "application/x-www-form-urlencoded")))) + (ignore url-request-extra-headers + url-request-data + url-request-method) + (url-retrieve emms-librefm-scrobbler-submission-url + #'emms-librefm-scrobbler-async-submission-callback + (list (cons track rating)))))) + +(defun emms-librefm-scrobbler-async-submission-callback (status &optional cbargs) + "Pass response of asynchronous submission call to handler." + (let ((response (emms-librefm-scrobbler-get-response-status))) + (ignore status) + ;; From the API docs: This indicates that the + ;; submission request was accepted for processing. It + ;; does not mean that the submission was valid, but + ;; only that the authentication and the form of the + ;; submission was validated. + (let ((track (car cbargs))) + (cond ((string= response "OK") + (when emms-librefm-scrobbler-display-submissions + (message "Libre.fm: Submitted %s" + (emms-track-get track 'info-title)))) + ((string= response "BADSESSION") + (emms-librefm-scrobbler-handshake) + (emms-librefm-scrobbler-make-async-submission-call (car cbargs) (cdr cbargs))) + (t + (error "unhandled submission failure")))))) + + +;;; ------------------------------------------------------------------ +;;; hooks +;;; ------------------------------------------------------------------ + +(defun emms-librefm-scrobbler-start-hook () + (setq emms-librefm-scrobbler-track-play-start-timestamp + (format-time-string "%s"))) + +(defun emms-librefm-scrobbler-stop-hook () + "Submit the track to libre.fm if it has been played for 240 +seconds or half the length of the track." + (let ((current-track (emms-playlist-current-selected-track))) + (let ((track-length (emms-track-get current-track 'info-playing-time))) + (when (and track-length + ;; only submit files + (eq (emms-track-type current-track) 'file)) + (when (and + ;; track must be longer than 30 secs + (> track-length 30) + ;; track must be played for more than 240 secs or + ;; half the tracks length, whichever comes first. + (> emms-playing-time (min 240 (/ track-length 2)))) + (emms-librefm-scrobbler-make-async-submission-call + current-track nil)))))) + +(defun emms-librefm-scrobbler-enable () + "Enable the scrobbler and submit played tracks." + (interactive) + (when (not emms-librefm-scrobbler-session-id) + (emms-librefm-scrobbler-handshake)) + (add-hook 'emms-player-started-hook + 'emms-librefm-scrobbler-start-hook t) + (add-hook 'emms-player-stopped-hook + 'emms-librefm-scrobbler-stop-hook) + (add-hook 'emms-player-finished-hook + 'emms-librefm-scrobbler-stop-hook)) + +(defun emms-librefm-scrobbler-disable () + "Disable the scrobbler and don't submit played tracks." + (interactive) + (setq emms-librefm-scrobbler-session-id nil) + (remove-hook 'emms-player-started-hook + 'emms-librefm-scrobbler-start-hook) + (remove-hook 'emms-player-stopped-hook + 'emms-librefm-scrobbler-stop-hook) + (remove-hook 'emms-player-finished-hook + 'emms-librefm-scrobbler-stop-hook)) + + +(provide 'emms-librefm-scrobbler) + + +;;; emms-librefm-scrobbler.el ends here diff --git a/elisp/emms-librefm-stream.el b/elisp/emms-librefm-stream.el new file mode 100644 index 0000000..f0ae0e5 --- /dev/null +++ b/elisp/emms-librefm-stream.el @@ -0,0 +1,384 @@ +;;; emms-librefm-stream.el --- Libre.FM streaming -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; Keywords: emms, libre.fm, GNU FM + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public +;; License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. + + +;;; Code: + +(require 'xml) +(require 'emms-playlist-mode) +(require 'emms-librefm-scrobbler) + + +(defvar emms-librefm-stream-host-url + "alpha.libre.fm" + "URL for the streaming host") + +(defvar emms-librefm-stream-host-base-path + "" + "URL for the streaming host base path") + +(defvar emms-librefm-stream-session-id + "" + "Session ID for radio.") + +(defvar emms-librefm-stream-debug + "" + "Temporary debug information.") + +(defvar emms-librefm-stream-station-name + "" + "Last station name tuned to.") + +(defvar emms-librefm-stream-emms-tracklist + "" + "List of tracks for streaming.") + +(defvar emms-librefm-stream-playlist-buffer-name + "*Emms GNU FM*" + "Name for non-interactive Emms GNU FM buffer.") + +(defvar emms-librefm-stream-playlist-buffer nil + "Non-interactive Emms GNU FM buffer.") + +(defvar emms-librefm-stream-connect-method "https://" + "Method of connecting to server.") + + +;;; ------------------------------------------------------------------ +;;; HTTP +;;; ------------------------------------------------------------------ + +(defun emms-librefm-stream-assert-http () + "Assert a sane HTTP response from the server. + +This function must be called inside the response buffer. Leaves +point after the HTTP headers." + (goto-char (point-min)) + (when (not (re-search-forward "^.*200 OK$" (line-end-position) t)) + (error "bad HTTP server response")) + ;; go to the start of the FM response + (when (not (re-search-forward "\n\n" (point-max) t)) + (error "bad FM server response"))) + + +;;; ------------------------------------------------------------------ +;;; radio handshake +;;; ------------------------------------------------------------------ + +(defun emms-librefm-stream-tune-handshake-string () + "Create the tune handshake string." + (let ((username (emms-librefm-scrobbler--username)) + (password (emms-librefm-scrobbler--password))) + (let ((url (concat emms-librefm-stream-connect-method + emms-librefm-stream-host-url + "/radio/handshake.php?" + "version=1.3.0.58" "&" + "platform=linux" "&" + "username=" (url-encode-url username) "&" + "passwordmd5=" (md5 password) "&" + "language=en"))) + url))) + +(defun emms-librefm-stream-tune-handshake-call () + "Make the tune handshake call." + (let ((url-request-method "POST")) + (ignore url-request-method) + (let ((response + (url-retrieve-synchronously + (emms-librefm-stream-tune-handshake-string)))) + (setq emms-librefm-stream-debug + (with-current-buffer response + (buffer-substring-no-properties (point-min) + (point-max)))) + response))) + +(defun emms-librefm-stream-handle-tune-handshake-response (resbuf) + "Handle the tune handshake server response." + (when (not (bufferp resbuf)) + (error "response not a buffer")) + (with-current-buffer resbuf + (emms-librefm-stream-assert-http) + (let (radio-session-id + base-url + base-path + (start (point))) + + (if (re-search-forward "^session=\\(.*\\)$" (point-max) t) + (setq radio-session-id (match-string-no-properties 1)) + (error "no radio session ID from server")) + + (goto-char start) + (if (re-search-forward "^base_url=\\(.*\\)$" (point-max) t) + (setq base-url (match-string-no-properties 1)) + (error "no base url from server")) + + (goto-char start) + (if (re-search-forward "^base_path=\\(.*\\)$" (point-max) t) + (setq base-path (match-string-no-properties 1)) + (error "no base path from server")) + + (setq emms-librefm-stream-session-id radio-session-id + emms-librefm-stream-host-url base-url + emms-librefm-stream-host-base-path base-path)) + + (message "radio handshake successful"))) + +(defun emms-librefm-stream-tune-handshake () + "Make and handle the tune handshake." + (emms-librefm-stream-handle-tune-handshake-response + (emms-librefm-stream-tune-handshake-call))) + + +;;; ------------------------------------------------------------------ +;;; tuning +;;; ------------------------------------------------------------------ + +(defun emms-librefm-stream-tune-string (session-id station) + "Create the tune string." + (when (not session-id) + (error "null session id")) + (when (not station) + (error "null station")) + (let ((url (concat emms-librefm-stream-connect-method + emms-librefm-stream-host-url + emms-librefm-stream-host-base-path + "/adjust.php?" + "session=" session-id "&" + "url=" (url-encode-url station)))) + url)) + +(defun emms-librefm-stream-tune-call (session-id station) + "Make the tune call." + (let ((url-request-method "POST")) + (ignore url-request-method) + (let ((response + (url-retrieve-synchronously + (emms-librefm-stream-tune-string + session-id station)))) + (setq emms-librefm-stream-debug + (with-current-buffer response + (buffer-substring-no-properties (point-min) + (point-max)))) + response))) + +(defun emms-librefm-stream-handle-tune-response (resbuf) + "Handle the tune server response." + (when (not (bufferp resbuf)) + (error "response not a buffer")) + (with-current-buffer resbuf + (emms-librefm-stream-assert-http) + (let (response + stationname + (start (point))) + + (if (re-search-forward "^response=\\(.*\\)$" (point-max) t) + (setq response (match-string-no-properties 1)) + (error "no response status code")) + (when (not (string= response "OK")) + (error "tune response not OK")) + + (goto-char start) + (if (re-search-forward "^stationname=\\(.*\\)$" (point-max) t) + (setq stationname (match-string-no-properties 1)) + (error "no stationname from server")) + + (setq emms-librefm-stream-station-name stationname) + + (message "successfully tuned to: %s" stationname)))) + +(defun emms-librefm-stream-tune (station) + "Make and handle tune call." + (emms-librefm-stream-handle-tune-response + (emms-librefm-stream-tune-call + emms-librefm-stream-session-id + station))) + + +;;; ------------------------------------------------------------------ +;;; radio.getPlaylist +;;; ------------------------------------------------------------------ + +(defun emms-librefm-stream-getplaylist-string (radio-session-id) + "Create the getplaylist string." + (when (not radio-session-id) + (error "null radio session id")) + (let ((url (concat emms-librefm-stream-connect-method + emms-librefm-stream-host-url + emms-librefm-stream-host-base-path + "/xspf.php?" + "sk=" radio-session-id "&" + "discovery=0" "&" + "desktop=1.3.0.58"))) + url)) + +(defun emms-librefm-stream-getplaylist-call (session-id) + "Make the getplaylist call." + (let ((url-request-method "POST")) + (ignore url-request-method) + (let ((response + (url-retrieve-synchronously + (emms-librefm-stream-getplaylist-string session-id)))) + (setq emms-librefm-stream-debug + (with-current-buffer response + (buffer-substring-no-properties (point-min) + (point-max)))) + response))) + +(defun emms-librefm-stream-handle-getplaylist-response (resbuf) + "Handle the getplaylist server response." + (when (not (bufferp resbuf)) + (error "response not a buffer")) + (with-current-buffer resbuf + (emms-librefm-stream-assert-http) + (xml-parse-region (point) (point-max)))) + +(defun emms-librefm-stream-getplaylist () + "Make and handle radio.getPlaylist." + (emms-librefm-stream-handle-getplaylist-response + (emms-librefm-stream-getplaylist-call + emms-librefm-stream-session-id))) + + +;;; ------------------------------------------------------------------ +;;; XSPF +;;; ------------------------------------------------------------------ +(defun emms-librefm-stream-xspf-find (tag data) + "Return the tracklist portion of PLAYLIST or nil." + (let ((tree (copy-tree data)) + result) + (while (and tree (not result)) + (let ((this (car tree))) + (when (and (listp this) + (eq (car this) tag)) + (setq result this))) + (setq tree (cdr tree))) + result)) + +(defun emms-librefm-stream-xspf-tracklist (playlist) + "Return the tracklist portion of PLAYLIST or nil." + (emms-librefm-stream-xspf-find 'trackList (car playlist))) + +(defun emms-librefm-stream-xspf-get (tag track) + "Return the data associated with TAG in TRACK." + (nth 2 (emms-librefm-stream-xspf-find tag track))) + +(defun emms-librefm-stream-xspf-convert-track (track) + "Convert TRACK to an Emms track." + (let ((location (emms-librefm-stream-xspf-get 'location track)) + (title (emms-librefm-stream-xspf-get 'title track)) + (album (emms-librefm-stream-xspf-get 'album track)) + (creator (emms-librefm-stream-xspf-get 'creator track)) + (duration (emms-librefm-stream-xspf-get 'duration track))) + (let ((emms-track (emms-dictionary '*track*))) + (emms-track-set emms-track 'name location) + (emms-track-set emms-track 'info-artist creator) + (emms-track-set emms-track 'info-title title) + (emms-track-set emms-track 'info-album album) + (emms-track-set emms-track 'info-playing-time + (/ (string-to-number duration) + 1000)) + (emms-track-set emms-track 'type 'url) + emms-track))) + +(defun emms-librefm-stream-xspf-convert-tracklist (tracklist) + "Convert TRACKLIST to a list of Emms tracks." + (let (tracks) + (mapc + #'(lambda (e) + (when (and (listp e) + (eq 'track (car e))) + (setq tracks + (append tracks + `(,(emms-librefm-stream-xspf-convert-track e)))))) + tracklist) + tracks)) + + +;;; ------------------------------------------------------------------ +;;; stream +;;; ------------------------------------------------------------------ + +(defun emms-librefm-stream-set-librefm-playlist-buffer () + "Setup the GNU FM buffer and make it `emms-playlist-buffer'." + (when (not (buffer-live-p emms-librefm-stream-playlist-buffer)) + (setq emms-librefm-stream-playlist-buffer + (emms-playlist-new + emms-librefm-stream-playlist-buffer-name))) + (setq emms-playlist-buffer emms-librefm-stream-playlist-buffer)) + +(defun emms-librefm-stream-queue () + "Queue streaming tracks." + (let ((tracklist + (emms-librefm-stream-xspf-tracklist + (emms-librefm-stream-getplaylist)))) + (when (not tracklist) + (setq emms-librefm-stream-emms-tracklist nil) + (error "could not find tracklist")) + (setq emms-librefm-stream-emms-tracklist + (emms-librefm-stream-xspf-convert-tracklist tracklist)) + + (emms-librefm-stream-set-librefm-playlist-buffer) + + (with-current-emms-playlist + (goto-char (point-max)) + (save-excursion + (mapc + #'(lambda (track) + (emms-playlist-insert-track track)) + emms-librefm-stream-emms-tracklist))))) + +(defun emms-librefm-stream-queue-loader () + "Queue more streaming music if needed." + (with-current-emms-playlist + (goto-char (if emms-playlist-mode-selected-overlay + (overlay-start emms-playlist-mode-selected-overlay) + (point-min))) + (when (and (eq (current-buffer) + emms-librefm-stream-playlist-buffer) + (not (next-single-property-change (line-end-position) + 'emms-track))) + (emms-librefm-stream-queue)))) + +(defun emms-librefm-stream (station) + "Stream STATION from a GNU FM server." + (interactive "sEnter station URL: ") + (when (not (stringp station)) + (error "bad argument")) + + (add-hook 'emms-player-finished-hook + 'emms-librefm-stream-queue-loader) + + (emms-librefm-stream-tune-handshake) + (emms-librefm-stream-tune station) + + (message "tuned to %s, getting playlist..." + emms-librefm-stream-station-name) + + (emms-librefm-stream-queue) + (with-current-emms-playlist + (emms-playlist-mode-play-current-track))) + + +(provide 'emms-librefm-stream) + +;;; emms-librefm-stream.el ends here diff --git a/elisp/emms-lyrics.el b/elisp/emms-lyrics.el new file mode 100644 index 0000000..34c2afd --- /dev/null +++ b/elisp/emms-lyrics.el @@ -0,0 +1,576 @@ +;;; emms-lyrics.el --- Display lyrics synchronically -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: William Xu +;; Keywords: emms music lyrics + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This package enables you to play music files and display lyrics +;; synchronically! :-) Plus, it provides a `emms-lyrics-mode' for +;; making lyric files. + +;; Put this file into your load-path and the following into your +;; ~/.emacs: +;; (require 'emms-lyrics) +;; +;; Then either `M-x emms-lyrics-enable' or add (emms-lyrics 1) in +;; your .emacs to enable. + +;;; TODO: + +;; 1. Maybe the lyric setup should run before `emms-start'. +;; 2. Give a user a chance to choose when finding out multiple lyrics. +;; 3. Search .lrc format lyrics from internet ? + +;;; Code: + +(require 'emms) +(require 'emms-player-simple) +(require 'emms-source-file) +(require 'time-date) +(require 'emms-url) +(require 'emms-compat) + +;;; User Customization + +(defgroup emms-lyrics nil + "Lyrics module for EMMS." + :group 'emms) + +(defcustom emms-lyrics-display-on-modeline t + "If non-nil, display lyrics on mode line." + :type 'boolean) + +(defcustom emms-lyrics-display-on-minibuffer nil + "If non-nil, display lyrics on minibuffer." + :type 'boolean) + +(defcustom emms-lyrics-display-buffer nil + "Non-nil will create deciated `emms-lyrics-buffer' to display lyrics." + :type 'boolean) + +(defcustom emms-lyrics-dir "~/music/lyrics" + "Local lyrics repository. +`emms-lyrics-find-lyric' will look for lyrics in current directory(i.e., +same as the music file) and this directory." + :type 'string) + +(defcustom emms-lyrics-display-format " %s " + "Format for displaying lyrics." + :type 'string) + +(defcustom emms-lyrics-coding-system nil + "Coding system for reading lyrics files. + +If all your lyrics use the same coding system, you can set this +variable to that value; else you'd better leave it to nil, and +rely on `prefer-coding-system', `file-coding-system-alist' or +\(info \"(emacs)File Variables\"), sorted by priority +increasingly." + :type 'coding-system) + +(defcustom emms-lyrics-mode-hook nil + "Normal hook run after entering Emms Lyric mode." + :type 'hook) + +(defcustom emms-lyrics-find-lyric-function 'emms-lyrics-find-lyric + "Function for finding lyric files." + :type 'symbol) + +(defcustom emms-lyrics-scroll-p t + "Non-nil value will enable lyrics scrolling on mode line. + +Note: Even if this is set to t, it also depends on +`emms-lyrics-display-on-modeline' to be t." + :type 'boolean) + +(defcustom emms-lyrics-scroll-timer-interval 0.4 + "Interval between scroller timers. The shorter, the faster." + :type 'number) + + +;;; User Interfaces + +(defvar emms-lyrics-display-p t + "If non-nil, will diplay lyrics.") + +(defvar emms-lyrics-mode-line-string "" + "Current lyric.") + +(defvar emms-lyrics-buffer nil + "Buffer to show lyrics.") + +(defvar emms-lyrics-chinese-url "http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word=%s&lm=-1" + "URL used to find Chinese lyrics. +Should contain one %s which is replaced with the filename.") + +(defvar emms-lyrics-latin-url "http://lyrics.wikia.com/%s%s" + "URL used to find Latin lyrics. +Should contain two %s-expressions. The first is replaced with +the artist and second with the title.") + +;;;###autoload +(defun emms-lyrics-enable () + "Enable displaying emms lyrics." + (interactive) + (emms-lyrics 1) + (message "emms lyrics enabled.")) + +;;;###autoload +(defun emms-lyrics-disable () + "Disable displaying emms lyrics." + (interactive) + (emms-lyrics -1) + (message "EMMS lyrics disabled")) + +;;;###autoload +(defun emms-lyrics-toggle () + "Toggle displaying emms lyrics." + (interactive) + (if emms-lyrics-display-p + (emms-lyrics-disable) + (emms-lyrics-enable))) + +(defun emms-lyrics-toggle-display-on-minibuffer () + "Toggle display lyrics on minibbufer." + (interactive) + (if emms-lyrics-display-on-minibuffer + (progn + (setq emms-lyrics-display-on-minibuffer nil) + (message "Disable lyrics on minibufer")) + (setq emms-lyrics-display-on-minibuffer t) + (message "Enable lyrics on minibufer"))) + +(defun emms-lyrics-toggle-display-on-modeline () + "Toggle display lyrics on mode line." + (interactive) + (if emms-lyrics-display-on-modeline + (progn + (setq emms-lyrics-display-on-modeline nil + emms-lyrics-mode-line-string "") + (message "Disable lyrics on mode line")) + (setq emms-lyrics-display-on-modeline t) + (message "Enable lyrics on mode line"))) + +(defun emms-lyrics-toggle-display-buffer () + "Toggle showing/hiding `emms-lyrics-buffer'." + (interactive) + (let ((w (get-buffer-window emms-lyrics-buffer))) + (if w + (delete-window w) + (save-selected-window + (pop-to-buffer emms-lyrics-buffer) + (set-window-dedicated-p w t))))) + +(defun emms-lyrics (arg) + "Turn on emms lyrics display if ARG is positive, off otherwise." + (interactive "p") + (if (and arg (> arg 0)) + (progn + (setq emms-lyrics-display-p t) + (add-hook 'emms-player-started-hook 'emms-lyrics-start) + (add-hook 'emms-player-stopped-hook 'emms-lyrics-stop) + (add-hook 'emms-player-finished-hook 'emms-lyrics-stop) + (add-hook 'emms-player-paused-hook 'emms-lyrics-pause) + (add-hook 'emms-player-seeked-functions 'emms-lyrics-seek) + (add-hook 'emms-player-time-set-functions 'emms-lyrics-sync)) + (emms-lyrics-stop) + (setq emms-lyrics-display-p nil) + (emms-lyrics-restore-mode-line) + (remove-hook 'emms-player-started-hook 'emms-lyrics-start) + (remove-hook 'emms-player-stopped-hook 'emms-lyrics-stop) + (remove-hook 'emms-player-finished-hook 'emms-lyrics-stop) + (remove-hook 'emms-player-paused-hook 'emms-lyrics-pause) + (remove-hook 'emms-player-seeked-functions 'emms-lyrics-seek) + (remove-hook 'emms-player-time-set-functions 'emms-lyrics-sync))) + +(defun emms-lyrics-visit-lyric () + "Visit playing track's lyric file. +If we can't find it from local disk, then search it from internet." + (interactive) + (let* ((track (emms-playlist-current-selected-track)) + (name (emms-track-get track 'name)) + (lrc (funcall emms-lyrics-find-lyric-function + (emms-replace-regexp-in-string + (concat "\\." (file-name-extension name) "\\'") + ".lrc" + (file-name-nondirectory name))))) + (if (and lrc (file-exists-p lrc) (not (string= lrc ""))) + (find-file lrc) + (message "Lyric file does not exist on file-system. Searching online...") + (let* ((title (or (emms-track-get track 'info-title) + (file-name-sans-extension + (file-name-nondirectory name)))) + (artist (when (emms-track-get track 'info-title) + (emms-track-get track 'info-artist))) + (url + (cond ((string-match "\\cc" title) ; Chinese lyrics. + ;; Since tag info might be encoded using various coding + ;; systems, we'd better fall back on filename. + (format emms-lyrics-chinese-url + (emms-url-quote-plus + (encode-coding-string name 'gb2312)))) + (t ; English lyrics.g + (format emms-lyrics-latin-url + (if artist (concat (emms-url-quote-underscore artist) ":") "") + (emms-url-quote-underscore title)))))) + (if (fboundp 'eww) + (progn (require 'eww) + (let ((readable-hook (when (fboundp 'eww-readable) + (add-hook 'eww-after-render-hook #'eww-readable) + #'eww-readable))) + (eww url) + (when readable-hook + (remove-hook 'eww-after-render-hook readable-hook)))) + (browse-url url)) + (message "Lyric file does not exist on file-system. Searching online..."))))) + + +;;; EMMS Lyrics + +(defvar emms-lyrics-alist nil + "a list of the form: \\='((time0 . lyric0) (time1 . lyric1)...)). In +short, at time-i, display lyric-i.") + +(defvar emms-lyrics-timers nil + "timers for displaying lyric.") + +(defvar emms-lyrics-start-time nil + "emms lyric start time.") + +(defvar emms-lyrics-pause-time nil + "emms lyric pause time.") + +(defvar emms-lyrics-elapsed-time 0 + "How long time has emms lyric played.") + +(defvar emms-lyrics-scroll-timers nil + "Lyrics scroller timers.") + +(defun emms-lyrics-read-file (file &optional catchup) + "Read a lyric file(LRC format). +Optional CATCHUP is for recognizing `emms-lyrics-catchup\\='. +FILE should end up with \".lrc\", its content looks like one of the +following: + + [1:39]I love you, Emacs! + [00:39]I love you, Emacs! + [00:39.67]I love you, Emacs! + +FILE should be under the same directory as the music file, or under +`emms-lyrics-dir\\='." + (or catchup + (setq file (funcall emms-lyrics-find-lyric-function file))) + (when (and file (file-exists-p file)) + (with-temp-buffer + (let ((coding-system-for-read emms-lyrics-coding-system)) + (emms-insert-file-contents file) + (while (search-forward-regexp "\\[[0-9:.]+\\].*" nil t) + (let ((lyric-string (match-string 0)) + (time 0) + (lyric "")) + (setq lyric + (emms-replace-regexp-in-string ".*\\]" "" lyric-string)) + (while (string-match "\\[[0-9:.]+\\]" lyric-string) + (let* ((time-string (match-string 0 lyric-string)) + (semi-pos (string-match ":" time-string))) + (setq time + (+ (* (string-to-number + (substring time-string 1 semi-pos)) + 60) + (string-to-number + (substring time-string + (1+ semi-pos) + (1- (length time-string)))))) + (setq lyric-string + (substring lyric-string (length time-string))) + (setq emms-lyrics-alist + (append emms-lyrics-alist `((,time . ,lyric)))) + (setq time 0))))) + (setq emms-lyrics-alist + (sort emms-lyrics-alist (lambda (a b) (< (car a) (car b)))))) + t))) + +(defun emms-lyrics-create-buffer () + "Create `emms-lyrics-buffer\\=' dedicated to lyrics. " + ;; leading white space in buffer name to hide the buffer + (setq emms-lyrics-buffer (get-buffer-create " *EMMS Lyrics*")) + (set-buffer emms-lyrics-buffer) + (setq buffer-read-only nil + cursor-type nil) + (erase-buffer) + (mapc (lambda (time-lyric) (insert (cdr time-lyric) "\n")) + emms-lyrics-alist) + (goto-char (point-min)) + (emms-activate-highlighting-mode) + (setq buffer-read-only t)) + +(defun emms-lyrics-start () + "Start displaying lryics." + (setq emms-lyrics-start-time (current-time) + emms-lyrics-pause-time nil + emms-lyrics-elapsed-time 0) + (when (let ((file + (emms-track-get + (emms-playlist-current-selected-track) + 'name))) + (emms-lyrics-read-file + (emms-replace-regexp-in-string + (concat "\\." (file-name-extension file) "\\'") + ".lrc" + (file-name-nondirectory file)))) + (when emms-lyrics-display-buffer + (emms-lyrics-create-buffer)) + (emms-lyrics-set-timer))) + +(defun emms-lyrics-catchup (lrc) + "Catchup with later downloaded LRC file(full path). +If you write some lyrics crawler, which is running asynchronically, +then this function would be useful to call when the crawler finishes its +job." + (let ((old-start emms-lyrics-start-time)) + (setq emms-lyrics-start-time (current-time) + emms-lyrics-pause-time nil + emms-lyrics-elapsed-time 0) + (emms-lyrics-read-file lrc t) + (emms-lyrics-set-timer) + (emms-lyrics-seek (float-time (time-since old-start))))) + +(defun emms-lyrics-stop () + "Stop displaying lyrics." + (interactive) + (when emms-lyrics-alist + (mapc #'emms-cancel-timer emms-lyrics-timers) + (if (or (not emms-player-paused-p) + emms-player-stopped-p) + (setq emms-lyrics-alist nil + emms-lyrics-timers nil + emms-lyrics-mode-line-string "")))) + +(defun emms-lyrics-pause () + "Pause displaying lyrics." + (if emms-player-paused-p + (setq emms-lyrics-pause-time (current-time)) + (when emms-lyrics-pause-time + (setq emms-lyrics-elapsed-time + (+ (float-time + (time-subtract emms-lyrics-pause-time + emms-lyrics-start-time)) + emms-lyrics-elapsed-time))) + (setq emms-lyrics-start-time (current-time))) + (when emms-lyrics-alist + (if emms-player-paused-p + (emms-lyrics-stop) + (emms-lyrics-set-timer)))) + +(defun emms-lyrics-seek (sec) + "Seek forward or backward SEC seconds lyrics." + (setq emms-lyrics-elapsed-time + (+ emms-lyrics-elapsed-time + (float-time (time-since emms-lyrics-start-time)) + sec)) + (when (< emms-lyrics-elapsed-time 0) ; back to start point + (setq emms-lyrics-elapsed-time 0)) + (setq emms-lyrics-start-time (current-time)) + (when emms-lyrics-alist + (let ((paused-orig emms-player-paused-p)) + (setq emms-player-paused-p t) + (emms-lyrics-stop) + (setq emms-player-paused-p paused-orig)) + (emms-lyrics-set-timer))) + +(defun emms-lyrics-sync (sec) + "Synchronize the lyric display at SEC seconds." + (setq emms-lyrics-start-time (current-time) + emms-lyrics-elapsed-time 0) + (emms-lyrics-seek sec)) + +(defun emms-lyrics-set-timer () + "Set timers for displaying lyrics." + (setq emms-lyrics-timers '()) + (let ((lyrics-alist emms-lyrics-alist) + (line 0)) + (while lyrics-alist + (let ((time (- (caar lyrics-alist) emms-lyrics-elapsed-time)) + (lyric (cdar lyrics-alist)) + (next-time (and (cdr lyrics-alist) + (- (car (cadr lyrics-alist)) + emms-lyrics-elapsed-time))) + (next-lyric (and (cdr lyrics-alist) + (cdr (cadr lyrics-alist))))) + (setq line (1+ line)) + (when (> time 0) + (setq emms-lyrics-timers + (append emms-lyrics-timers + (list + (run-at-time (format "%d sec" time) + nil + #'emms-lyrics-display-handler + lyric + next-lyric + line + (and next-time (- next-time time))))))) + (setq lyrics-alist (cdr lyrics-alist)))))) + +(defun emms-lyrics-mode-line () + "Add lyric to the mode line." + (or global-mode-string (setq global-mode-string '(""))) + (unless (member 'emms-lyrics-mode-line-string + global-mode-string) + (setq global-mode-string + (append global-mode-string + '(emms-lyrics-mode-line-string))))) + +(defun emms-lyrics-restore-mode-line () + "Restore the mode line." + (setq global-mode-string + (remove 'emms-lyrics-mode-line-string global-mode-string)) + (force-mode-line-update)) + +(defun emms-lyrics-display-handler (lyric next-lyric line diff) + "DIFF is the timestamp differences between current LYRIC and +NEXT-LYRIC; LINE corresponds line number for LYRIC in `emms-lyrics-buffer\\='." + (emms-lyrics-display (format emms-lyrics-display-format lyric) line) + (when (and emms-lyrics-display-on-modeline emms-lyrics-scroll-p) + (emms-lyrics-scroll lyric next-lyric diff))) + +(defun emms-lyrics-display (lyric line) + "Display LYRIC now. +See `emms-lyrics-display-on-modeline\\=' and +`emms-lyrics-display-on-minibuffer\\=' on how to config where to +display." + (when emms-lyrics-alist + (when emms-lyrics-display-on-modeline + (emms-lyrics-mode-line) + (setq emms-lyrics-mode-line-string lyric) + ;; (setq emms-lyrics-mode-line-string ; make it fit scroller width + ;; (concat emms-lyrics-mode-line-string + ;; (make-string + ;; (abs (- emms-lyrics-scroll-width (length lyric))) + ;; (string-to-char " ")))) + (force-mode-line-update)) + + (when emms-lyrics-display-on-minibuffer + (unless (minibuffer-window-active-p (selected-window)) + (message lyric))) + + (when emms-lyrics-display-buffer + (with-current-buffer emms-lyrics-buffer + (when line + (goto-char (point-min)) + (forward-line (1- line)) + (emms-line-highlight)))))) + +(defun emms-lyrics-find-lyric (file) + "Return full path of found lrc FILE, or nil if not found. +Use `emms-source-file-directory-tree-function\\=' to find lrc FILE under +current directory and `emms-lyrics-dir\\='. +e.g., (emms-lyrics-find-lyric \"abc.lrc\")" + (let* ((track (emms-playlist-current-selected-track)) + (lyric-under-curr-dir + (concat (file-name-directory (emms-track-get track 'name)) + file))) + (or (and (eq (emms-track-type track) 'file) + (file-exists-p lyric-under-curr-dir) + lyric-under-curr-dir) + (car (funcall emms-source-file-directory-tree-function + emms-lyrics-dir + file))))) + +;; (setq emms-lyrics-scroll-width 20) + +(defun emms-lyrics-scroll (lyric next-lyric diff) + "Scroll LYRIC to left smoothly in DIFF seconds. +DIFF is the timestamp differences between current LYRIC and +NEXT-LYRIC." + (setq diff (floor diff)) + (setq emms-lyrics-scroll-timers '()) + (let ((scrolled-lyric (concat lyric " " next-lyric)) + (time 0) + (pos 0)) + (catch 'return + (while (< time diff) + (setq emms-lyrics-scroll-timers + (append emms-lyrics-scroll-timers + (list + (run-at-time time + nil + #'emms-lyrics-display + (if (>= (length lyric) pos) + (substring scrolled-lyric pos) + (throw 'return t)) + nil)))) + (setq time (+ time emms-lyrics-scroll-timer-interval)) + (setq pos (1+ pos)))))) + + +;;; emms-lyrics-mode + +(defvar emms-lyrics-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "p" #'emms-lyrics-previous-line) + (define-key map "n" #'emms-lyrics-next-line) + (define-key map "i" #'emms-lyrics-insert-time) + map) + "Keymap for `emms-lyrics-mode\\='.") + +(defun emms-lyrics-rem* (x y) + "The remainder of X divided by Y, with the same sign as X." + (let* ((q (floor x y)) + (rem (- x (* y q)))) + (if (= rem 0) + 0 + (if (eq (>= x 0) (>= y 0)) + rem + (- rem y))))) + +(defun emms-lyrics-insert-time () + "Insert lyric time in the form: [01:23.21], then goto the +beginning of next line." + (interactive) + (let* ((total (+ (float-time + (time-subtract (current-time) + emms-lyrics-start-time)) + emms-lyrics-elapsed-time)) + (min (/ (* (floor (/ total 60)) 100) 100)) + (sec (/ (floor (* (emms-lyrics-rem* total 60) 100)) 100.0))) + (insert (emms-replace-regexp-in-string + " " "0" (format "[%2d:%2d]" min sec)))) + (emms-lyrics-next-line)) + +(defun emms-lyrics-next-line () + "Goto the beginning of next line." + (interactive) + (forward-line 1)) + +(defun emms-lyrics-previous-line () + "Goto the beginning of previous line." + (interactive) + (forward-line -1)) + +(define-derived-mode emms-lyrics-mode nil "Emms Lyric" + "Major mode for creating lyric files. +\\{emms-lyrics-mode-map}" + (run-hooks 'emms-lyrics-mode-hook)) + +(provide 'emms-lyrics) + +;;; emms-lyrics.el ends here diff --git a/elisp/emms-maint.el b/elisp/emms-maint.el new file mode 100644 index 0000000..fd5c4a4 --- /dev/null +++ b/elisp/emms-maint.el @@ -0,0 +1,3 @@ +;; Copyright (C) 2003-2020 Free Software Foundation, Inc. + +(add-to-list 'load-path ".") diff --git a/elisp/emms-mark.el b/elisp/emms-mark.el new file mode 100644 index 0000000..b0afa28 --- /dev/null +++ b/elisp/emms-mark.el @@ -0,0 +1,295 @@ +;;; emms-mark.el --- mark track like dired -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2023 Free Software Foundation, Inc. +;; +;; Author: Ye Wenbin + +;; This file is part of EMMS. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Provide mark operation to tracks + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'emms-mark) + +;; To activate it for the current buffer only, do: +;; (emms-mark-mode) + +;; To make this the default EMMS mode, do: +;; (setq emms-playlist-default-major-mode 'emms-mark-mode) + +;;; Code: + +(provide 'emms-mark) +(require 'cl-lib) +(require 'emms) +(require 'emms-playlist-mode) + +;;{{{ set new description-function +(defun emms-mark-track-description (track) + "Return a description of the current track." + (cl-assert (not (eq (default-value 'emms-track-description-function) + 'emms-mark-track-description)) + nil (concat "Do not set `emms-track-selection-function' to be" + " emms-mark-track-description.")) + (concat " " (funcall (default-value 'emms-track-description-function) + track))) + +(defun emms-mark-update-descriptions () + "Update the track descriptions in the current buffer." + (emms-with-inhibit-read-only-t + (save-excursion + (goto-char (point-min)) + (emms-walk-tracks + (emms-playlist-update-track))))) +;;}}} + +;;{{{ functions to mark tracks +(defvar emms-mark-char ?*) +(defvar emms-mark-face-alist + '((?* . font-lock-warning-face) + (?\040 . emms-playlist-track-face))) + +(defun emms-mark-track (&optional arg) + "Mark the current track. +If ARG is positive, also mark the next ARG-1 tracks as well. +If ARG is negative, also mark the previous ARG-1 tracks." + (interactive "p") + (or arg (setq arg 1)) + (let ((face (assoc-default emms-mark-char emms-mark-face-alist)) + buffer-read-only track) + (save-excursion + (beginning-of-line) + (while (and (not (eobp)) + (/= arg 0)) + (setq track (get-text-property (point) 'emms-track)) + (delete-char 1) + (insert (emms-propertize (string emms-mark-char) + 'emms-track track)) + (backward-char 1) + (if (> arg 0) + ;; Propertizing forward... + (put-text-property (point) + (progn (forward-line 1) (point)) + 'face face) + ;; ... and backward + (let ((start (save-excursion (end-of-line) (point)))) + (put-text-property (progn (beginning-of-line) (point)) + start + 'face face)) + (forward-line -1)) + (setq arg (if (> arg 0) + (1- arg) + (1+ arg))))))) + +(defun emms-mark-unmark-track (&optional arg) + "Unmark the current track. +If ARG is positive, also unmark the next ARG-1 tracks as well. +If ARG is negative, also unmark the previous ARG-1 tracks." + (interactive "p") + (let ((emms-mark-char ?\040)) + (emms-mark-track arg))) + +(defun emms-mark-forward (arg) + "Mark one or more tracks and move the point past the newly-marked tracks. +See `emms-mark-track' for further details." + (interactive "p") + (emms-mark-track arg) + (forward-line arg)) + +(defun emms-mark-unmark-forward (arg) + "Unmark one or more tracks and move the point past the tracks. +See `emms-mark-unmark-track' for further details." + (interactive "p") + (emms-mark-unmark-track arg) + (forward-line arg)) + +(defun emms-mark-all () + "Mark all tracks in the current buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (emms-mark-track (count-lines (point-min) (point-max))))) + +(defun emms-mark-unmark-all () + "Unmark all tracks in the current buffer." + (interactive) + (emms-mark-do-with-marked-track 'emms-mark-unmark-track)) + +(defun emms-mark-regexp (regexp arg) + "Mark all tracks matching REGEXP. A prefix argument means to +unmark them instead." + (interactive + (list + (read-from-minibuffer (if current-prefix-arg + "Unmark tracks matching: " + "Mark tracks matching: ")) + current-prefix-arg)) + (let ((emms-mark-char (if arg ?\040 ?*))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (emms-mark-track 1) + (forward-line 1))))) + +(defun emms-mark-toggle () + "Toggle all marks in the current buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (let (buffer-read-only) + (while (not (eobp)) + (if (eq ?\040 (following-char)) + (emms-mark-track) + (emms-mark-unmark-track)) + (forward-line 1))))) + +(defsubst emms-mark-has-markedp () + "Return non-nil if the playlist has a marked line, nil otherwise." + (save-excursion + (goto-char (point-min)) + (re-search-forward (format "^[%c]" emms-mark-char) nil t))) + +;;}}} + +;;{{{ functions to operate marked tracks +(defun emms-mark-do-with-marked-track (func &optional move) + "Call FUNC on every marked line in current playlist. +The function specified by FUNC takes no argument, so if the track +on the marked line is needed, use `emms-playlist-track-at' to get +it. + +The function can also modify the playlist buffer, such as +deleting the current line. If the function doesn't move forward, +be sure to set the second parameter MOVE to non-nil. Otherwise +the function will never exit the loop." + (let ((regexp (format "^[%c]" emms-mark-char)) + (newfunc func)) + (if move + (setq newfunc (lambda () (funcall func) (forward-line 1)))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (backward-char 1) ; move to beginning of line + (funcall newfunc))))) + +(defun emms-mark-mapcar-marked-track (func &optional move) + "This function does the same thing as +`emms-mark-do-with-marked-track', the only difference being that +this function collects the result of FUNC." + (let ((regexp (format "^[%c]" emms-mark-char)) + result (newfunc func)) + (if move + (setq newfunc (lambda () (let ((res (funcall func))) + (forward-line 1) res)))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (backward-char 1) ; move to beginning of line + (setq result (cons (funcall newfunc) result))) + (nreverse result)))) + +(defun emms-mark-delete-marked-tracks () + "Delete all tracks that have been marked in the current buffer." + (interactive) + (emms-with-inhibit-read-only-t + (emms-mark-do-with-marked-track + (lambda nil (delete-region (point) + (progn (forward-line 1) (point))))))) + +(defun emms-mark-kill-marked-tracks () + "Kill all tracks that have been marked in the current buffer." + (interactive) + (let (tracks buffer-read-only) + (emms-mark-do-with-marked-track + (lambda nil + (setq tracks + (concat tracks + (delete-and-extract-region (point) + (progn (forward-line 1) (point))))))) + (kill-new tracks))) + +(defun emms-mark-copy-marked-tracks () + "Copy all tracks that have been marked in the current buffer." + (interactive) + (let (tracks) + (emms-mark-do-with-marked-track + (lambda nil + (setq tracks + (concat tracks + (buffer-substring (point) + (progn (forward-line 1) (point))))))) + (kill-new tracks))) +;;}}} + +;;{{{ mode stuff +(defvar emms-mark-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "W" #'emms-mark-copy-marked-tracks) + (define-key map "K" #'emms-mark-kill-marked-tracks) + (define-key map "D" #'emms-mark-delete-marked-tracks) + (define-key map "m" #'emms-mark-forward) + (define-key map "u" #'emms-mark-unmark-forward) + (define-key map "U" #'emms-mark-unmark-all) + (define-key map "t" #'emms-mark-toggle) + (define-key map "%m" #'emms-mark-regexp) + map) + "Keymap for `emms-mark-mode'.") + +(defun emms-mark-mode () ;FIXME: Use `define-derived-mode'. + "An EMMS major mode that allows tracks to be marked like dired. +\\{emms-mark-mode-map}" + (interactive) + (if (eq major-mode 'emms-mark-mode) + ;; do nothing if we're already in emms-mark-mode + nil + + ;; start emms-playlist-mode exactly once + (unless (eq major-mode 'emms-playlist-mode) + (emms-playlist-mode)) + (setq emms-playlist-buffer-p t) + + ;; use inherited keymap + (set-keymap-parent emms-mark-mode-map (current-local-map)) + (use-local-map emms-mark-mode-map) + (setq major-mode 'emms-mark-mode + mode-name "Emms-Mark") + + ;; show a blank space at beginning of each line + (set (make-local-variable 'emms-track-description-function) + #'emms-mark-track-description) + (emms-mark-update-descriptions))) + +(defun emms-mark-mode-disable () + "Disable `emms-mark-mode' and return to `emms-playlist-mode'." + (interactive) + (if (not (eq major-mode 'emms-mark-mode)) + ;; do nothing if we're not in emms-mark-mode + nil + + ;; call emms-playlist-mode, saving important variables + (let ((selected emms-playlist-selected-marker)) + (emms-playlist-mode) + (setq emms-playlist-selected-marker selected) + (emms-playlist-mode-overlay-selected)) + + ;; update display + (emms-mark-update-descriptions))) +;;}}} + +;;; emms-mark.el ends here diff --git a/elisp/emms-metaplaylist-mode.el b/elisp/emms-metaplaylist-mode.el new file mode 100644 index 0000000..d980888 --- /dev/null +++ b/elisp/emms-metaplaylist-mode.el @@ -0,0 +1,242 @@ +;;; emms-metaplaylist-mode.el --- A major mode for lists of Emms playlists -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301, USA. + +;;; Commentary: +;; +;; `emms-metaplaylist-mode' creates an interactive list of all the +;; Emms playlist buffers. The currently active buffer is +;; highlighted. You can choose a buffer from the list with RET and get +;; taken there. + +;;; Code: + +(require 'emms) +(require 'emms-playlist-mode) + +;;; -------------------------------------------------------- +;;; Variables, customisation and faces +;;; -------------------------------------------------------- + +(defgroup emms-metaplaylist-mode nil + "*The Emacs Multimedia System meta-playlist mode." + :prefix "emms-metaplaylist-mode-" + :group 'multimedia) + +(defcustom emms-metaplaylist-mode-buffer-name "*Emms Playlist Buffers*" + "Name of the buffer in which Emms playlists will be listed." + :type 'string) + +(defcustom emms-metaplaylist-mode-hooks nil + "List of hooks to run on entry to emms-metaplaylist-mode." + :type 'list) + +(defface emms-metaplaylist-mode-face + '((((class color) (background dark)) + (:foreground "AntiqueWhite3")) + (((class color) (background light)) + (:foreground "red3")) + (((type tty) (class mono)) + (:inverse-video t)) + (t (:background "WhiteSmoke"))) + "Face for the buffer names in the playlists buffer.") + +(defface emms-metaplaylist-mode-current-face + '((((class color) (background dark)) + (:foreground "red2")) + (((class color) (background light)) + (:background "red3" :foreground "white")) + (((type tty) (class mono)) + (:inverse-video t)) + (t (:background "red3"))) + "Face for the current buffer name in the playlists buffer.") + +;;; -------------------------------------------------------- +;;; Keymap +;;; -------------------------------------------------------- + +(defvar emms-metaplaylist-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map (kbd "n") #'next-line) + (define-key map (kbd "p") #'previous-line) + (define-key map (kbd "RET") #'emms-metaplaylist-mode-goto-current) + (define-key map (kbd "SPC") #'emms-metaplaylist-mode-set-active) + (define-key map (kbd "g") #'emms-metaplaylist-mode-update) + (define-key map (kbd "C") #'emms-metaplaylist-mode-new-buffer) + (define-key map (kbd "C-k") #'emms-metaplaylist-mode-kill-buffer) + (define-key map (kbd "c") #'emms-metaplaylist-mode-center-current) + (define-key map (kbd "q") #'kill-this-buffer) + (define-key map (kbd "?") #'describe-mode) + map) + "Keymap for `emms-metaplaylist-mode'.") + +;;; -------------------------------------------------------- +;;; Metaplaylist +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-mode-goto-current () + "Switch to the buffer at point." + (interactive) + (let ((buffer (get-buffer + (buffer-substring (line-beginning-position) + (line-end-position))))) + (emms-playlist-set-playlist-buffer buffer) + (switch-to-buffer buffer))) + +(defun emms-metaplaylist-mode-write (playlists) + "Print the sorted list of PLAYLISTS." + (delete-region (point-min) (point-max)) + (mapc (lambda (buf) + (let ((inhibit-read-only t)) + (insert (buffer-name buf)) + (add-text-properties + (line-beginning-position) (line-end-position) + (list 'face + (if (eq buf emms-playlist-buffer) + 'emms-metaplaylist-mode-current-face + 'emms-metaplaylist-mode-face))) + (newline))) + playlists)) + +;; Emms' list changes order, and that's OK, but we want something +;; stable for display purposes. +(defun emms-metaplaylist-mode-sorted-buffer-list () + "Return a sorted list of playlist buffers." + (sort + (copy-tree + (emms-playlist-buffer-list)) + #'(lambda (a b) + (string< (buffer-name a) + (buffer-name b))))) + +(defun emms-metaplaylist-mode-center-current () + "Center on the current playlist buffer" + (interactive) + (when (buffer-name emms-playlist-buffer) + (let ((p nil)) + (save-excursion + (goto-char (point-min)) + (setq p (search-forward-regexp (regexp-quote + (buffer-name emms-playlist-buffer)) + (point-max) t))) + (when (not p) (error "cannot not find the current playlist buffer")) + (goto-char p) + (goto-char (line-beginning-position))))) + +(defun emms-metaplaylist-mode-create () + "Create the meta-playlist buffer." + (let ((name emms-metaplaylist-mode-buffer-name) + (playlists (emms-metaplaylist-mode-sorted-buffer-list))) + (if playlists + (with-current-buffer (get-buffer-create name) + (emms-metaplaylist-mode) + (emms-metaplaylist-mode-write playlists) + (emms-metaplaylist-mode-center-current) + (current-buffer)) + (error "No Emms playlist buffers")))) + +(defun emms-metaplaylist-mode-assert-buffer () + "Assert that we are in the metaplaylist mode buffer." + (when (not (eq (current-buffer) + (get-buffer emms-metaplaylist-mode-buffer-name))) + (error "not the metalplaylist buffer"))) + +(defun emms-metaplaylist-mode-update () + "Update the metalplaylist display." + (interactive) + (emms-metaplaylist-mode-assert-buffer) + (let ((inhibit-read-only t)) + (emms-metaplaylist-mode-write + (emms-metaplaylist-mode-sorted-buffer-list))) + (emms-metaplaylist-mode-center-current)) + +(defun emms-metaplaylist-mode-kill-buffer () + "Kill the buffer at point" + (interactive) + (let ((buffer (get-buffer + (buffer-substring (line-beginning-position) + (line-end-position))))) + (when (not buffer) + (error "can't find buffer at point")) + (if (y-or-n-p (format "kill playlist buffer \"%s\"?" + (buffer-name buffer))) + (kill-buffer buffer) + (message "Buffer kill aborted.")) + (emms-metaplaylist-mode-update))) + + +;;; -------------------------------------------------------- +;;; Playlist Management +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-mode-new-buffer (buffer-name) + "Creates a new buffer playlist buffer BUFFER-NAME." + (interactive "sBuffer Name: ") + (if (get-buffer buffer-name) + (error "Buffer must not exist.") + (let ((buf (get-buffer-create buffer-name))) + (with-current-buffer buf + (emms-playlist-mode) + (setq emms-playlist-buffer-p t))) + (emms-metaplaylist-mode-update))) + +(defun emms-metaplaylist-mode-set-active () + "Set the buffer at point to be the active playlist." + (interactive) + (emms-playlist-set-playlist-buffer + (get-buffer (buffer-substring (line-beginning-position) (line-end-position)))) + (emms-metaplaylist-mode-update)) + + +;;; -------------------------------------------------------- +;;; Mode entry +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-mode-go () + "Single entry point to the metaplaylist interface." + (interactive) + (let ((mpm-buffer (get-buffer emms-metaplaylist-mode-buffer-name))) + (if mpm-buffer + (with-current-buffer mpm-buffer + (emms-metaplaylist-mode-update)) + (setq mpm-buffer (emms-metaplaylist-mode-create))) + (switch-to-buffer mpm-buffer))) + +(defun emms-metaplaylist-mode () + "A major mode for Emms playlists. + +\\{emms-metaplaylist-mode-map}" + ;; (interactive) + (kill-all-local-variables) + + (use-local-map emms-metaplaylist-mode-map) + (setq major-mode 'emms-metaplaylist-mode + mode-name "Emms-MetaPlaylist") + + (setq buffer-read-only t) + + (run-hooks 'emms-metaplaylist-mode-hooks)) + +(provide 'emms-metaplaylist-mode) + +;;; emms-metaplaylist-mode.el ends here diff --git a/elisp/emms-mode-line-icon.el b/elisp/emms-mode-line-icon.el new file mode 100644 index 0000000..5e82e4e --- /dev/null +++ b/elisp/emms-mode-line-icon.el @@ -0,0 +1,86 @@ +;; emms-mode-line-icon.el --- show an icon in the Emacs mode-line -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. + +;; Version: 1.1 +;; Keywords: emms + +;; Author: Daniel Brockman +;; Maintainer: Lucas Bonnet + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;; Commentary: + +;; This EMMS extension shows an icon in the mode-line next to the +;; info-tag. + +;; Code: + +(require 'emms-mode-line) + + +(defvar emms-mode-line-icon-enabled-p t + "Disable icon display when NIL.") + +(defvar emms-mode-line-icon-color "black" + "Color of the little icon displayed in the mode-line.") + +(defvar emms-mode-line-icon-before-format "" + "String to put before the icon, in the mode-line. +For example, if you want to have something like : +\[ Foo - The Foo Song ] +You should set it to \"[\", and set emms-mode-line-format to \"%s ]\"") + +(defun emms-mode-line-icon-generate (color) + `(image :type xpm :ascent center :data ,(concat "/* XPM */ +static char *note[] = { +/* width height num_colors chars_per_pixel */ +\" 10 11 2 1\", +/* colors */ +\". c " color "\", +\"# c None s None\", +/* pixels */ +\"###...####\", +\"###.#...##\", +\"###.###...\", +\"###.#####.\", +\"###.#####.\", +\"#...#####.\", +\"....#####.\", +\"#..######.\", +\"#######...\", +\"######....\", +\"#######..#\"};"))) + +(defun emms-mode-line-icon-function () + (if emms-mode-line-icon-enabled-p + (concat " " + emms-mode-line-icon-before-format + (emms-propertize "NP:" 'display + (emms-mode-line-icon-generate + emms-mode-line-icon-color)) + (emms-mode-line-playlist-current)) + (emms-mode-line-playlist-current))) + +(setq emms-mode-line-mode-line-function #'emms-mode-line-icon-function) + +;; This is needed for text properties to work in the mode line. +(put 'emms-mode-line-string 'risky-local-variable t) + +(provide 'emms-mode-line-icon) +;;; emms-mode-line-icone.el ends here diff --git a/elisp/emms-mode-line.el b/elisp/emms-mode-line.el new file mode 100644 index 0000000..404453f --- /dev/null +++ b/elisp/emms-mode-line.el @@ -0,0 +1,157 @@ +;;; emms-mode-line.el --- Mode-Line and titlebar infos for emms -*- lexical-binding: t; -*- + +;; Copyright (C) 2004-2021 Free Software Foundation, Inc. + +;; Author: Mario Domgörgen +;; Keywords: multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; To activate put simply the following line in your Emacs: +;; +;; (require 'emms-mode-line) +;; (emms-mode-line 1) + +;;; Code: + +(require 'emms) + +(defgroup emms-mode-line nil + "Showing information on mode-line and titlebar" + :prefix "emms-mode-line-" + :group 'emms) + +(defcustom emms-mode-line-mode-line-function #'emms-mode-line-playlist-current + "Function for showing infos in mode-line or nil if don't want to." + :type '(choice (const :tag "Don't show info on mode-line" nil) function)) + +(defcustom emms-mode-line-titlebar-function nil + "Function for showing infos in titlebar or nil if you don't want to." + :type '(choice (const :tag "Don't show info on titlebar" nil) function)) + +(defcustom emms-mode-line-format " [ %s ] " + "String used for displaying the current track in mode-line and titlebar." + :type 'string + :group 'emms) + +(defun emms-mode-line-playlist-current () + "Format the currently playing song." + (format emms-mode-line-format (emms-track-description + (emms-playlist-current-selected-track)))) + +(define-obsolete-variable-alias 'emms-mode-line-active-p + 'emms-mode-line-mode "Apr 2021") +(defvar emms-mode-line-string "") + +(defvar emms-mode-line-initial-titlebar frame-title-format) + +(defun emms-mode-line (arg) + (declare (obsolete emms-mode-line-mode "Apr 2021")) + (emms-mode-line-mode (if (and arg (> arg 0)) 1 -1))) + +;;;###autoload +(define-minor-mode emms-mode-line-mode + "Turn on `emms-mode-line' if ARG is positive, off otherwise." + :global t + (or global-mode-string (setq global-mode-string '(""))) + (if emms-mode-line-mode + (progn + (add-hook 'emms-track-updated-functions #'emms-mode-line-alter) + (add-hook 'emms-player-finished-hook #'emms-mode-line-blank) + (add-hook 'emms-player-stopped-hook #'emms-mode-line-blank) + (add-hook 'emms-player-started-hook #'emms-mode-line-alter) + (when (and emms-mode-line-mode-line-function + (not (member 'emms-mode-line-string global-mode-string))) + (setq global-mode-string + (append global-mode-string + '(emms-mode-line-string)))) + (when emms-player-playing-p (emms-mode-line-alter))) + (remove-hook 'emms-track-updated-functions #'emms-mode-line-alter) + (remove-hook 'emms-player-finished-hook #'emms-mode-line-blank) + (remove-hook 'emms-player-stopped-hook #'emms-mode-line-blank) + (remove-hook 'emms-player-started-hook #'emms-mode-line-alter) + (emms-mode-line-restore-titlebar) + (emms-mode-line-restore-mode-line))) + +;;;###autoload +(defun emms-mode-line-enable () + "Turn on `emms-mode-line'." + (declare (obsolete emms-mode-line-mode "Apr 2021")) + (interactive) + (emms-mode-line-mode 1)) + +;;;###autoload +(defun emms-mode-line-disable () + "Turn off `emms-mode-line'." + (interactive) + (emms-mode-line-mode -1)) + +;;;###autoload +(defun emms-mode-line-toggle () + "Toggle `emms-mode-line'." + (declare (obsolete emms-mode-line-mode "Apr 2021")) + (interactive) + (emms-mode-line-mode 'toggle)) + +(defun emms-mode-line-alter (&optional track) + "Alter mode-line/titlebar. + +Optional TRACK is used to be compatible with +`emms-track-updated-functions'. It's simply ignored currently." + (ignore track) + (emms-mode-line-alter-mode-line) + (emms-mode-line-alter-titlebar)) + +(defun emms-mode-line-alter-mode-line () + "Update the mode-line with song info." + (when (and emms-mode-line-mode-line-function + emms-player-playing-p) + (setq emms-mode-line-string + (funcall emms-mode-line-mode-line-function)) + (force-mode-line-update))) + +(defun emms-mode-line-alter-titlebar () + "Update the titlebar with song info." + (when emms-mode-line-titlebar-function + (setq frame-title-format + (list "" emms-mode-line-initial-titlebar (funcall emms-mode-line-titlebar-function))))) + + +(defun emms-mode-line-blank () + "Blank mode-line and titlebar but not quit `emms-mode-line'." + (setq emms-mode-line-string nil) + (force-mode-line-update) + (emms-mode-line-restore-titlebar)) + +(defun emms-mode-line-restore-mode-line () + "Restore the mode-line." + (when emms-mode-line-mode-line-function + (setq global-mode-string + (remove 'emms-mode-line-string global-mode-string)) + (force-mode-line-update))) + +(defun emms-mode-line-restore-titlebar () + "Restore the mode-line." + (when emms-mode-line-titlebar-function + (setq frame-title-format + (list emms-mode-line-initial-titlebar)))) + +(provide 'emms-mode-line) +;;; emms-mode-line.el ends here diff --git a/elisp/emms-mpris.el b/elisp/emms-mpris.el new file mode 100644 index 0000000..b65ed18 --- /dev/null +++ b/elisp/emms-mpris.el @@ -0,0 +1,575 @@ +;;; emms-mpris.el --- Mpris interface for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2023 Free Software Foundation, Inc. + +;; Author: Fran Burstall +;; Keywords: multimedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: +;; This package provides a dbus interface to EMMS. + +;; Usage: +;; (require 'emms-mpris) +;; (emms-mpris-enable) + +;; Switch off with +;; (emms-mpris-disable) + +;; Caveats: this is not quite a complete implementation of the +;; org.mpris.MediaPlayer2 and org.mpris.MediaPlayer2.Player interfaces +;; (see +;; https://specifications.freedesktop.org/mpris-spec/latest/index.html). +;; What is missing: +;; - Volume: this should be easy but there seems to be no way to get a +;; simple percentage to report the volume---every emms-volume +;; controller returns a string in a different format, sigh. + + + +;;; Code: + +;;* What we need +(require 'dbus) +(require 'url-parse) +(require 'emms) +(require 'emms-browser) +(require 'emms-playing-time) +(require 'cl-lib) +(require 'pcase) +(require 'subr-x) +(require 'seq) + +;;* Dbus components +(defconst emms-mpris-service "org.mpris.MediaPlayer2.emms" + "The service we expose.") + +(defconst emms-mpris-path "/org/mpris/MediaPlayer2" + "Our object path.") + +;;* Register and update +(defun emms-mpris-register-method (iface method handler) + "Register METHOD with HANDLER on interface IFACE." + (dbus-register-method :session + emms-mpris-service + emms-mpris-path + iface + method + handler + t)) + +(defun emms-mpris-register-property (iface property access value) + "Register PROPERTY on interface IFACE. + +VALUE is the initial value, ACCESS the access mode." + (let ((val (cond ((functionp value) (funcall value)) + ((and (symbolp value) (boundp value)) (symbol-value value)) + (t value)))) + (dbus-register-property :session + emms-mpris-service + emms-mpris-path + iface + property + access + val + ;; emit signal when readwrite properties change + (equal access :readwrite) + t))) + +(defun emms-mpris-register-iface (spec) + "Register an interface with spec SPEC on the EMMS service. + +The spec is a list of the form (IFACE METHODS PROPS). + +IFACE is a string naming the interface being registered. + +METHODS is a list of methods to register on the interface. +Each method is a list (NAME FN) with NAME a string and FN the +function the method calls. + +PROPS is a list of properties to register on the interface. +Each property is a list of the form (NAME ACCESS VAL) with +NAME a string, ACCESS a keyword and VAL either a function +that returns the default value of the property, a variable +which evaluates to that value or the value itself." + (cl-destructuring-bind (iface methods props) spec + (dolist (method methods) + (apply #'emms-mpris-register-method iface method)) + (dolist (prop props) + (apply #'emms-mpris-register-property iface prop)))) + + +;;* Interfaces + +;;** MediaPlayer2 interface + +(defvar emms-mpris-mediaplayer-iface-spec + '("org.mpris.MediaPlayer2" + (("Raise" ignore) + ("Quit" ignore)) + (("CanQuit" :read nil) + ("CanRaise" :read nil) + ("HasTrackList" :read nil) + ("Identity" :read "EMMS media player") + ("SupportedUriSchemes" :read (:array "file")) + ("SupportedMimeTypes" :read (:array "audio/mpeg" "application/ogg")))) + "Interface spec for MediaPlayer2.") + +;;** MediaPlayer2.Player interface + +(defvar emms-mpris-player-iface-spec + '("org.mpris.MediaPlayer2.Player" + ;; Methods: + (("OpenUri" emms-mpris-open-uri) + ("Next" (lambda () (ignore-errors (emms-next)) :ignore)) + ("Previous" (lambda () (ignore-errors (emms-previous)) :ignore)) + ("Pause" (lambda () (emms-pause) :ignore)) + ("PlayPause" (lambda () (emms-pause) :ignore)) + ("Stop" (lambda () (emms-stop) :ignore)) + ("Play" (lambda () (emms-pause) :ignore)) + ("Seek" emms-mpris-seek) + ("SetPosition" emms-mpris-set-position)) + ;; Properties: Shuffle, LoopStatus, Volume not supported (yet) + (("LoopStatus" :readwrite emms-mpris-loop-status) + ("Shuffle" :readwrite emms-random-playlist) + ("PlaybackStatus" :read emms-mpris-status) + ("Rate" :readwrite 1.0) + ("MinimumRate" :read 1.0) + ("MaximumRate" :read 1.0) + ("Position" :read (:int64 0)) ;think more about this + ("CanGoNext" :read t) + ("CanGoPrevious" :read t) + ("CanPlay" :read t) + ("CanPause" :read t) + ("CanPause" :read t) + ("CanControl" :read t) + ("CanSeek" :read t) + ("Metadata" :read emms-mpris-current-metadata))) + "Interface spec for MediaPlayer2.Player.") +;;** Introspection interface + +(defvar emms-mpris-xml + " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +" + "Mpris introspection data for emms.") + +(defun emms-mpris-introspect () + "Return dbus introspection data." + emms-mpris-xml) + +(defvar emms-mpris-introspectable-iface-spec + '("org.freedesktop.DBus.Introspectable" + (("Introspect" emms-mpris-introspect)) + nil) + "Introspectable interface spec for dbus.") + +;;** Properties interface + +;; We re-implement the "Get" and "GetAll" methods of the +;; dbus.properties interface. For why? Well, the default handler +;; looks up the value of a property in a hash table which works fine +;; unless we want the "Position" property of the Player interface +;; which changes all the time (and we don't want to update the table +;; every second!). So we wrap the default handler to update the +;; Position entry in the table before delegating to the default +;; handler. This is a bit of a hack in that we go rather beyond the +;; API of dbus.el and hope that the internals do not change. + +(defun emms-mpris-update-position-hash-value () + "Update the D-Bus hash-table. + +Refresh the value in the hash-table corresponding to the Position +property of the org.mpris.MediaPlayer2.Player interface." + (puthash (list :property :session "org.mpris.MediaPlayer2.Player" "Position") + (list (list nil + emms-mpris-service + emms-mpris-path + (list :read nil (list :variant :int64 (emms-mpris-sec-to-musec emms-playing-time))))) + dbus-registered-objects-table)) + +(defun emms-mpris-get-property-handler (&rest args) + "Handle Get and GetAll event for property in ARGS. + +The Position property gets refreshed before delegating +to `dbus-property-handler'." + (let* ((last-input-event last-input-event)) + (emms-mpris-update-position-hash-value) + (apply #'dbus-property-handler args))) + +(defvar emms-mpris-properties-iface-spec + '("org.freedesktop.DBus.Properties" + (("Get" emms-mpris-get-property-handler) + ("GetAll" emms-mpris-get-property-handler)) + nil) + "Partial Properties interface spec for dbus.") + + +;;* Implementation + +;;** Utilities +;; Emms thinks in seconds but mpris in microseconds +(defun emms-mpris-musec-to-sec (ms) + "Convert MS microseconds to seconds." + (* ms .000001)) + +(defun emms-mpris-sec-to-musec (s) + "Convert S seconds to microseconds." + (truncate (* s 1000000))) + +;; Track-id is a d-bus object id and these have rules... +(defun emms-mpris-track-id (track) + "Return track-id of TRACK as D-Bus object id." + ;; FIX ME: this won't work if we implement the tracklist interface + ;; and the tracklist has repeated tracks. + (concat "/" (mapconcat #'dbus-escape-as-identifier + (split-string (emms-track-get track 'name) "/" t) + "/"))) + +;;** Update properties +(defun emms-mpris-update-property (iface property access value) + "Update PROPERTY on interface IFACE to VALUE." + (dbus-register-property :session + emms-mpris-service + emms-mpris-path + iface + property + access + value + t nil)) + +(defvar emms-mpris-ignore-signal-p nil + "Non-nil if we should ignore a PropertiesChanged signal. + +We do this when we have already taken action via the EMMS UI.") + +(defun emms-mpris-property-change-handler (_service changes _invalidated) + "Respond to PropertiesChanged signal by updating emms state to reflect CHANGES." + (if emms-mpris-ignore-signal-p + (setq emms-mpris-ignore-signal-p nil) + (when-let ((payload (assoc "LoopStatus" changes))) + (pcase (caadr payload) + ("Track" (setq emms-repeat-playlist nil + emms-repeat-track t)) + ("Playlist" (setq emms-repeat-playlist t + emms-repeat-track nil)) + (_ (setq emms-repeat-playlist nil + emms-repeat-track nil)))) + (when-let ((payload (assoc "Shuffle" changes))) + (setq emms-random-playlist (caadr payload)) + (if emms-random-playlist + (setq emms-player-next-function #'emms-random) + (setq emms-player-next-function #'emms-next-noerror))))) + +;;*** Playback status +(defun emms-mpris-status () + "Return the playback status of EMMS as string: Playing, Paused or Stopped." + (if emms-player-playing-p + (if emms-player-paused-p + "Paused" "Playing") + "Stopped")) + +;;*** Loop status +(defun emms-mpris-loop-status () + "Return the loop status of EMMS as a string: Track, Playlist or None." + (cond (emms-repeat-track "Track") + (emms-repeat-playlist "Playlist") + (t "None"))) + +(defun emms-mpris-advise-loop-status () + "Update dbus value of LoopStatus. + +Intended to advise emms-toggle-repeat-*." + (setq emms-mpris-ignore-signal-p t) + (dbus-set-property :session + emms-mpris-service + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "LoopStatus" + (emms-mpris-loop-status))) + +;;*** Shuffle +(defun emms-mpris-advise-shuffle () + "Update dbus value of Shuffle. + +Intended to advise `emms-toggle-random-playlist'." + (setq emms-mpris-ignore-signal-p t) + (dbus-set-property :session + emms-mpris-service + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "Shuffle" + emms-random-playlist)) + +;;*** Metadata + +(defvar emms-mpris-metadata-dict + '((info-album "xesam:album" :s) + (info-albumartist "xesam:albumArtist" :as) + (info-artist "xesam:artist" :as) + (info-composer "xesam:composer" :as) + (info-discnumber "xesam:discNumber" :int) + (info-tracknumber "xesam:trackNumber" :int) + (info-title "xesam:title" :s) + (play-count "xesam:useCount" :int)) + "Dictionary between emms metadata and mpris metadata. + +Each entry of the form (info-field mpris-field dbus-type).") + +(defun emms-mpris-dict (k v &optional type) + "Return a dbus dict-entry with key K and value V, optionally of type TYPE." + (if type + (list :dict-entry k (list :variant type v)) + (list :dict-entry k (list :variant v)))) + +(defun emms-mpris-convert-field (track info key type) + "Convert field INFO of TRACK into dbus dict-entry with key KEY and type TYPE." + (let ((data (emms-track-get track info)) + value) + (when data + (setq value (pcase type + (:as (list :array data)) + (:int (if (stringp data) (string-to-number data) data)) + (:s data))) + (emms-mpris-dict key value)))) + +(defun emms-mpris-metadata (track) + "Return mpris metadata for TRACK." + (let ((track-name (emms-track-get track 'name)) + metadata) + ;; standard fields + (dolist (field emms-mpris-metadata-dict) + (when-let ((entry (apply #'emms-mpris-convert-field track field))) + (push entry metadata))) + ;; url + (push (emms-mpris-dict "xesam:url" (url-encode-url (concat "file:" track-name))) metadata) + ;; artUrl + ;; Shockingly, emms-browser-get-cover-from-path needs a graphical display to + ;; function (it eventually calls image-size) so we check there is one... + (when (seq-some #'display-graphic-p (frame-list)) + (when-let ((art-file (emms-browser-get-cover-from-path track-name 'medium))) + (push (emms-mpris-dict "mpris:artUrl" (url-encode-url (concat "file://" art-file))) metadata))) + ;; length + (push + (emms-mpris-dict "mpris:length" + (emms-mpris-sec-to-musec (emms-track-get track 'info-playing-time 0)) + :int64) + metadata) + ;; trackid + (push + (emms-mpris-dict "mpris:trackid" + (emms-mpris-track-id track) + :object-path) + metadata) + (cons :array metadata))) + +(defun emms-mpris-current-metadata () + "Return metadata of current track if it exists, else return a placeholder." + (if-let ((track (emms-playlist-current-selected-track))) + (emms-mpris-metadata track) + '(:array (:dict-entry "mpris:trackid" (:variant :object-path "/no/track/here"))))) + +;;*** update them! +(defun emms-mpris-change-status () + "Notify emms status to dbus." + (let ((iface "org.mpris.MediaPlayer2.Player")) + (emms-mpris-update-property iface + "PlaybackStatus" + :read + (emms-mpris-status)) + (emms-mpris-update-property iface + "Metadata" + :read + (emms-mpris-current-metadata)))) + + +;;** Seek and SetPosition + +;;*** Signal position change (after Seek or SetPosition) +(defun emms-mpris-signal-position (pos) + "Send \"Seeked\" signal with new position POS (in seconds)." + (dbus-send-signal :session + nil + emms-mpris-path + "org.mpris.MediaPlayer2.Player" + "Seeked" + :int64 + (emms-mpris-sec-to-musec pos))) + +;;*** Seek method +(defun emms-mpris-seek (ms) + "Method to seek by MS microseconds." + (emms-seek (number-to-string (emms-mpris-musec-to-sec ms))) + (emms-mpris-signal-position emms-playing-time) + :ignore) + +;;*** SetPosition method +(defun emms-mpris-set-position (track-id pos) + "Method to seek to POS (in microseconds) if current track has id TRACK-ID." + (let* ((track (emms-playlist-current-selected-track)) + (duration (emms-track-get track 'info-playing-time 0)) + (current-track-id (emms-mpris-track-id track)) + (pos-in-secs (emms-mpris-musec-to-sec pos))) + (when (and (string-equal track-id current-track-id) + (<= 0.0 pos-in-secs duration)) + (emms-seek-to (number-to-string pos-in-secs)) + (emms-mpris-signal-position emms-playing-time)) + :ignore)) + +;;** OpenURI + +(defun emms-mpris-open-uri (uri) + "Method for opening file URI and playing it." + (let* ((parsed-uri (url-generic-parse-url uri)) + (file (url-unhex-string (url-filename parsed-uri))) + (type (url-type parsed-uri))) + (when (and (string-equal type "file") (file-exists-p file)) + (cond ((file-regular-p file) (emms-play-file file)) + ((file-directory-p file) (emms-play-directory file))))) + :ignore) + + +;;* Entry point + +(defvar emms-mpris-enabled-p nil + "Non-nil if the EMMS mpris service is enabled.") + +(defun emms-mpris-enable () + "Activate EMMS dbus service." + (interactive) + (unless emms-mpris-enabled-p + (emms-mpris-register-iface emms-mpris-mediaplayer-iface-spec) + (emms-mpris-register-iface emms-mpris-player-iface-spec) + (emms-mpris-register-iface emms-mpris-introspectable-iface-spec) + (emms-mpris-register-iface emms-mpris-properties-iface-spec) + (dbus-register-service :session emms-mpris-service :allow-replacement) + (dbus-register-signal :session + emms-mpris-service + emms-mpris-path + dbus-interface-properties + "PropertiesChanged" + #'emms-mpris-property-change-handler + :eavesdrop) + (advice-add 'emms-toggle-repeat-track :after #'emms-mpris-advise-loop-status) + (advice-add 'emms-toggle-repeat-playlist :after #'emms-mpris-advise-loop-status) + (advice-add 'emms-toggle-random-playlist :after #'emms-mpris-advise-shuffle) + (add-hook 'emms-player-started-hook #'emms-mpris-change-status) + (add-hook 'emms-player-paused-hook #'emms-mpris-change-status) + (add-hook 'emms-player-stopped-hook #'emms-mpris-change-status) + (add-hook 'emms-player-finished-hook #'emms-mpris-change-status) + (setq emms-mpris-enabled-p t))) + +(defun emms-mpris-disable () + "Turn off EMMS dbus service." + (interactive) + (when emms-mpris-enabled-p + (remove-hook 'emms-player-started-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-paused-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-stopped-hook #'emms-mpris-change-status) + (remove-hook 'emms-player-finished-hook #'emms-mpris-change-status) + (advice-remove 'emms-toggle-repeat-track #'emms-mpris-advise-loop-status) + (advice-remove 'emms-toggle-repeat-playlist #'emms-mpris-advise-loop-status) + (advice-remove 'emms-toggle-random-playlist #'emms-mpris-advise-shuffle) + ;; Call this twice: we have two methods for "Get" on the Properties + ;; interface (there /must/ be a better way to do this!): + (dbus-unregister-service :session emms-mpris-service) + (dbus-unregister-service :session emms-mpris-service) + (setq emms-mpris-enabled-p nil))) + + +(provide 'emms-mpris) +;;; emms-mpris.el ends here diff --git a/elisp/emms-player-mpd.el b/elisp/emms-player-mpd.el new file mode 100644 index 0000000..d1d6257 --- /dev/null +++ b/elisp/emms-player-mpd.el @@ -0,0 +1,1361 @@ +;;; emms-player-mpd.el --- MusicPD support for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2023 Free Software Foundation, Inc. + +;; Author: Michael Olson , Jose Antonio Ortega Ruiz +;; + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public +;; License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Benefits of MusicPD + +;; MusicPD features crossfade, very little skipping, minor CPU usage, +;; many clients, many supported output formats, fast manipulation via +;; network processes, and good abstraction of client and server. + +;;; MusicPD setup + +;; If you want to set up a local MusicPD server, you'll need to have +;; mpd installed. If you want to use a remote server instance, no +;; installation is needed. + +;; The website is at http://musicpd.org/. Debian packages are +;; available. It is recommended to use mpd version 0.12.0 or higher. +;; +;; Copy the example configuration for mpd into ~/.mpdconf and edit it +;; to your needs. Use your top level music directory for +;; music_directory. If your playlists use absolute file names, be +;; certain that music_directory has the leading directory part. +;; +;; Before you try to play anything, but after setting up the above, +;; run `mkdir ~/.mpd && mpd --create-db' to create MusicPD's track +;; database. +;; +;; Check to see if mpd is running. It must be running as a daemon for +;; you to be able to play anything. Launch it by executing "mpd". It +;; can be killed later with "mpd --kill" (or just "killall mpd" if +;; you're not using the latest development version). + +;;; EMMS setup + +;; Add the following to your config. +;; +;; (require 'emms-player-mpd) + +;; Adjust `emms-player-mpd-server-name' and +;; `emms-player-mpd-server-port' to match the location and port of +;; your MusicPD server. +;; +;; (setq emms-player-mpd-server-name "localhost") +;; (setq emms-player-mpd-server-port "6600") + +;; If your MusicPD setup requires a password, you will need to do the +;; following. +;; +;; (setq emms-player-mpd-server-password "mypassword") + +;; To get track info from MusicPD, do the following. +;; +;; (add-to-list 'emms-info-functions #'emms-info-mpd) + +;; To change the volume using MusicPD, do the following. +;; +;; (setq emms-volume-change-function #'emms-volume-mpd-change) + +;; Add 'emms-player-mpd to the top of `emms-player-list'. +;; +;; (add-to-list 'emms-player-list 'emms-player-mpd) + +;; If you use absolute file names in your m3u playlists (which is most +;; likely), make sure you set `emms-player-mpd-music-directory' to the +;; value of "music_directory" from your MusicPD config. There are +;; additional options available as well, but the defaults should be +;; sufficient for most uses. + +;; You can set `emms-player-mpd-sync-playlist' to nil if your master +;; EMMS playlist contains only stored playlists. + +;; If at any time you wish to replace the current EMMS playlist buffer +;; with the contents of the MusicPD playlist, type +;; M-x emms-player-mpd-connect. +;; +;; This will also run the relevant seek functions, so that if you use +;; emms-playing-time, the displayed time will be accurate. + +;;; Contributors + +;; Adam Sjøgren implemented support for changing the volume. + +(require 'cl-lib) +(require 'emms-player-simple) +(require 'emms-playlist-mode) +(require 'emms-source-playlist) ; for emms-source-file-parse-playlist +(require 'tq) +(require 'emms-cache) +(require 'emms-url) + +(eval-when-compile + (condition-case nil + (progn + (require 'url) ; load if available + (require 'emms-url)) + (error nil))) + +(defgroup emms-player-mpd nil + "EMMS player for MusicPD." + :group 'emms-player + :prefix "emms-player-mpd-") + +(defcustom emms-player-mpd (emms-player #'emms-player-mpd-start + #'emms-player-mpd-stop + #'emms-player-mpd-playable-p) + "Parameters for the MusicPD player." + :type '(cons symbol alist)) + +(defcustom emms-player-mpd-music-directory nil + "The value of \\='music_directory\\=' in your MusicPD configuration file. + +Unless your MusicPD is configured to use absolute file names, you must +set this variable to the value of \\='music_directory\\=' in your MusicPD +config." + ;; The :format part ensures that entering directories happens on the + ;; next line, where there is more space to work with + :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" + (const nil) + directory)) + +(defun emms-player-mpd-get-supported-regexp () + "Returns a regexp of file extensions that MusicPD supports, +or nil if we cannot figure it out." + (let ((out (shell-command-to-string "mpd --version"))) + ;; 0.17.x + (if (string-match "Decoders plugins:$" out) + (let* ((b (match-end 0)) + (e (string-match "Output plugins:$" out)) + (plugs (split-string (substring out b e) "\n" t)) + (plugs (cl-mapcan (lambda (x) + (and (string-match " +\\[.*\\] +\\(.+\\)$" x) + (split-string (match-string 1 x) nil t))) + plugs)) + (b (and (string-match "Protocols:$" out) (match-end 0))) + (prots (and b (substring out (+ 2 b) -1))) + (prots (split-string (or prots "") nil t))) + (concat "\\(\\.\\(m3u\\|pls\\|" + (regexp-opt (delq nil plugs)) + "\\)\\'\\)\\|\\(\\`" + (regexp-opt (delete "file://" prots)) "\\)")) + (let ((found-start nil) + (supported nil)) + (if (string-match "Supported decoders:\\([^0]+?\\)Supported outputs:" out) + ;; 0.15.x + (setq supported (replace-regexp-in-string "\\[.+?\\]" "" + (match-string 1 out))) + ;; < 0.15 + (setq out (split-string out "\n")) + (while (car out) + (cond ((string= (car out) "Supported formats:") + (setq found-start t)) + ((string= (car out) "") + (setq found-start nil)) + (found-start + (setq supported (concat supported (car out))))) + (setq out (cdr out)))) + ;; Create regexp + (when (and (stringp supported) + (not (string= supported ""))) + (concat "\\`http://\\|\\.\\(m3u\\|pls\\|" + (regexp-opt (delq nil (split-string supported))) + "\\)\\'")))))) + +(defcustom emms-player-mpd-supported-regexp + ;; Use a sane default, just in case + (or (emms-player-mpd-get-supported-regexp) + (concat "\\`http://\\|" + (emms-player-simple-regexp + "m3u" "ogg" "flac" "mp3" "wav" "mod" "au" "aiff"))) + "Formats supported by MusicPD." + :type 'regexp + :set (function + (lambda (sym value) + (set sym value) + (emms-player-set emms-player-mpd 'regex value)))) + +(defcustom emms-player-mpd-connect-function 'open-network-stream + "Function used to initiate the connection to MusicPD. +It should take same arguments as `open-network-stream' does." + :type 'function) + +(defcustom emms-player-mpd-server-name (or (getenv "MPD_HOST") "localhost") + "The MusicPD server that we should connect to." + :type 'string) + +(defcustom emms-player-mpd-server-port (or (getenv "MPD_PORT") "6600") + "The port of the MusicPD server that we should connect to." + :type '(choice number string)) + +(defcustom emms-player-mpd-server-password nil + "The password for the MusicPD server that we should connect to." + :type '(choice (const :tag "None" nil) + string)) + +(defcustom emms-player-mpd-check-interval 1 + "How often to check to see whether MusicPD has advanced to the +next song. This may be an integer, a floating point number, or +nil. If set to nil, this check will not be periodically +performed. + +This variable is used only if `emms-player-mpd-sync-playlist' is +non-nil." + :type '(choice (const :tag "Disable check" nil) + number)) + +(defcustom emms-player-mpd-verbose nil + "Whether to provide notifications for server connection events +and errors." + :type 'boolean) + +(defcustom emms-player-mpd-sync-playlist t + "Whether to synchronize the EMMS playlist with the MusicPD playlist. + +If your EMMS playlist contains music files rather than playlists, +leave this set to non-nil. + +If your EMMS playlist contains stored playlists, set this to nil." + :type 'boolean) + +(emms-player-set emms-player-mpd + 'regex + emms-player-mpd-supported-regexp) + +(emms-player-set emms-player-mpd + 'pause + 'emms-player-mpd-pause) + +(emms-player-set emms-player-mpd + 'resume + 'emms-player-mpd-pause) + +(emms-player-set emms-player-mpd + 'seek + 'emms-player-mpd-seek) + +(emms-player-set emms-player-mpd + 'seek-to + 'emms-player-mpd-seek-to) + +;;; Dealing with the MusicPD network process + +(defvar emms-player-mpd-process nil) +(defvar emms-player-mpd-queue nil) + +(defvar emms-player-mpd-playlist-id nil) +(make-variable-buffer-local 'emms-player-mpd-playlist-id) + +(defvar emms-player-mpd-current-status nil) +(defvar emms-player-mpd-last-state nil) +(defvar emms-player-mpd-status-timer nil) + +(defvar emms-player-mpd-status-regexp + "^\\(OK\\( MPD \\)?\\|ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)\\)\n+\\'" + "Regexp that matches the valid status strings that MusicPD can +return at the end of a request.") + +(defun emms-player-mpd-sentinel (proc event) + "The process sentinel for MusicPD." + (let ((status (process-status proc))) + (cond ((string-match "^deleted" event) + (when emms-player-mpd-verbose + (message "MusicPD process was deleted"))) + ((memq status '(exit signal closed)) + (emms-player-mpd-close-process t) + (when emms-player-mpd-verbose + (message "Closed MusicPD process"))) + ((memq status '(run open)) + (when emms-player-mpd-verbose + (message "MusicPD process started successfully"))) + (t + (when emms-player-mpd-verbose + (message "Other MusicPD status change: %s, %s" status event)))))) + +(defun emms-player-mpd-ensure-process () + "Make sure that a MusicPD process is currently active." + (unless (and emms-player-mpd-process + (processp emms-player-mpd-process) + (memq (process-status emms-player-mpd-process) '(run open))) + (setq emms-player-mpd-process + (if emms-player-mpd-server-port + (funcall emms-player-mpd-connect-function "mpd" + nil + emms-player-mpd-server-name + emms-player-mpd-server-port) + (make-network-process :name "emms-mpd" + :service emms-player-mpd-server-name + :family 'local))) + (set-process-sentinel emms-player-mpd-process + #'emms-player-mpd-sentinel) + (setq emms-player-mpd-queue + (tq-create emms-player-mpd-process)) + (set-process-query-on-exit-flag emms-player-mpd-process nil) + ;; send password + (when (stringp emms-player-mpd-server-password) + (tq-enqueue emms-player-mpd-queue + (concat "password " emms-player-mpd-server-password "\n") + emms-player-mpd-status-regexp nil #'ignore t)))) + +(defun emms-player-mpd-close-process (&optional from-sentinel) + "Terminate the current MusicPD client process. +FROM-SENTINEL indicates whether this was called by the process sentinel, +in which case certain checks should not be made." + (when (or from-sentinel + (and (processp emms-player-mpd-process) + (memq (process-status emms-player-mpd-process) '(run open)))) + (tq-close emms-player-mpd-queue) + (setq emms-player-mpd-queue nil) + (setq emms-player-mpd-process nil))) + +(defun emms-player-mpd-send (question closure fn) + "Send the given QUESTION to the MusicPD server. +When a reply comes, call FN with CLOSURE and the result." + (emms-player-mpd-ensure-process) + (unless (string= (substring question -1) "\n") + (setq question (concat question "\n"))) + (tq-enqueue emms-player-mpd-queue question + emms-player-mpd-status-regexp + closure fn t)) + +;;; Helper functions + +(defun emms-player-mpd-get-mpd-filename (file) + "Turn FILE into something that MusicPD can understand. + +This usually means removing a prefix." + (if (or (not emms-player-mpd-music-directory) + (not (eq (aref file 0) ?/)) + (string-match "\\`http://" file)) + file + (file-relative-name file emms-player-mpd-music-directory))) + +(defun emms-player-mpd-get-emms-filename (file) + "Turn FILE into something that EMMS can understand. + +This usually means adding a prefix." + (if (or (not emms-player-mpd-music-directory) + (eq (aref file 0) ?/) + (string-match "\\`http://" file)) + file + (expand-file-name file emms-player-mpd-music-directory))) + +(defun emms-player-mpd-parse-response (response) + "Convert the given MusicPD response into a list. + +The car of the list is special: +If an error has occurred, it will contain a cons cell whose car is +an error number and whose cdr is the corresponding message. +Otherwise, it will be nil." + (when (stringp response) + (save-match-data + (let* ((data (split-string response "\n")) + (cruft (last data 3)) + (status (if (string= (cadr cruft) "") + (car cruft) + (cadr cruft)))) + (setcdr cruft nil) + (when (and (stringp (car data)) + (string-match "^OK\\( MPD \\)?" (car data))) + (setq data (cdr data))) + (if (and (stringp status) + (string-match "^ACK \\[\\([0-9]+\\)@[0-9]+\\] \\(.+\\)" + status)) + (cons (cons (match-string 1 status) + (match-string 2 status)) + data) + (cons nil data)))))) + +(defun emms-player-mpd-parse-line (line) + "Turn the given LINE from MusicPD into a cons cell. + +The format of the cell is (name . value)." + (when (string-match "\\`\\([^:\n]+\\):\\s-*\\(.+\\)" line) + (let ((name (match-string 1 line)) + (value (match-string 2 line))) + (if (and name value) + (progn + (setq name (downcase name)) + (cons name value)) + nil)))) + +(defun emms-player-mpd-get-alist (info) + "Turn the given parsed INFO from MusicPD into an alist." + (when (and info + (null (car info)) ; no error has occurred + (cdr info)) ; data exists + (let ((alist nil) + cell old-cell) + (dolist (line (cdr info)) + (when (setq cell (emms-player-mpd-parse-line line)) + (if (setq old-cell (assoc (car cell) alist)) + (setcdr old-cell (cdr cell)) + (setq alist (cons cell alist))))) + alist))) + +(defun emms-player-mpd-get-alists (info) + "Turn the given parsed INFO from MusicPD into an list of alists. + +The list will be in reverse order." + (when (and info + (null (car info)) ; no error has occurred + (cdr info)) ; data exists + (let ((alists nil) + (alist nil) + cell) + (dolist (line (cdr info)) + (when (setq cell (emms-player-mpd-parse-line line)) + (if (member (car cell) '("file" "directory" "playlist")) + (setq alists (cons alist alists) + alist (list cell)) + (setq alist (cons cell alist))))) + (when alist + (setq alists (cons alist alists))) + alists))) + +(defun emms-player-mpd-get-tracks-1 (closure response) + (let ((songs (emms-player-mpd-get-alists + (emms-player-mpd-parse-response response))) + (tracks nil)) + (when songs + (dolist (song-info songs) + (let ((file (cdr (assoc "file" song-info)))) + (when file + (setq file (emms-player-mpd-get-emms-filename file)) + (let* ((type (if (string-match "\\`http://" file) + 'url + 'file)) + (track (emms-track type file))) + (emms-info-mpd track song-info) + (run-hook-with-args 'emms-track-info-filters track) + (setq tracks (cons track tracks))))))) + (funcall (car closure) (cdr closure) tracks))) + +(defun emms-player-mpd-get-tracks (closure callback) + "Get the current playlist from MusicPD in the form of a list of +EMMS tracks. +Call CALLBACK with CLOSURE and result when the request is complete." + (emms-player-mpd-send "playlistinfo" (cons callback closure) + #'emms-player-mpd-get-tracks-1)) + +(defun emms-player-mpd-get-status-1 (closure response) + (funcall (car closure) + (cdr closure) + (emms-player-mpd-get-alist + (emms-player-mpd-parse-response response)))) + +(defun emms-player-mpd-get-status (closure callback) + "Get status information from MusicPD. +It will be returned in the form of an alist by calling CALLBACK +with CLOSURE as its first argument, and the status as the +second." + (emms-player-mpd-send "status" (cons callback closure) + #'emms-player-mpd-get-status-1)) + +(defun emms-player-mpd-get-status-part (closure callback item &optional info) + "Get ITEM from the current MusicPD status. +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (if info + (funcall callback closure (cdr (assoc item info))) + (emms-player-mpd-get-status + (cons callback (cons closure item)) + (lambda (closure info) + (let ((fn (car closure)) + (close (cadr closure)) + (item (cddr closure))) + (funcall fn close (cdr (assoc item info)))))))) + +(defun emms-player-mpd-get-playlist-id (closure callback &optional info) + "Get the current playlist ID from MusicPD. +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure id) (ignore closure) id))) + (emms-player-mpd-get-status-part closure callback "playlist" info)) + +(defun emms-player-mpd-get-volume (closure callback &optional info) + "Get the current volume from MusicPD. +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure volume) (ignore closure) volume))) + (emms-player-mpd-get-status-part closure callback "volume" info)) + +(defun emms-player-mpd-get-current-song (closure callback &optional info) + "Get the current song from MusicPD. +This is in the form of a number that indicates the position of +the song on the current playlist. + +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure id) (ignore closure) id))) + (emms-player-mpd-get-status-part closure callback "song" info)) + +(defun emms-player-mpd-get-current-songid (closure callback &optional info) + "Get the current songid from MusicPD. +This is in the form of a number, which is an immutable, unique +identifier per track in a playlist. + +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure id) (ignore closure) id))) + (emms-player-mpd-get-status-part closure callback "songid" info)) + +(defun emms-player-mpd-get-current-consume (closure callback &optional info) + "Get the current consume mode from MusicPD. +When consume mode is enabled, MPD deletes tracks after they've been +played, as it moves to the next track in the playlist. + +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure id) (ignore closure) id))) + (emms-player-mpd-get-status-part closure callback "consume" info)) + +(defun emms-player-mpd-get-mpd-state (closure callback &optional info) + "Get the current state of the MusicPD server. +This is either \"play\", \"stop\", or \"pause\". + +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (when info + (setq callback (lambda (closure id) (ignore closure) id))) + (emms-player-mpd-get-status-part closure callback "state" info)) + +(defun emms-player-mpd-get-playing-time (closure callback &optional info) + "Get the number of seconds that the current song has been playing, +or nil if we cannot obtain this information. + +Call CALLBACK with CLOSURE and result when the request is complete. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (if info + (emms-player-mpd-get-status-part + nil + (lambda (closure time) + (ignore closure) + (and time + (string-match "\\`\\([0-9]+\\):" time) + (string-to-number (match-string 1 time)))) + "time" info) + (emms-player-mpd-get-status-part + (cons callback closure) + (lambda (closure time) + (funcall (car closure) + (cdr closure) + (and time + (string-match "\\`\\([0-9]+\\):" time) + (string-to-number (match-string 1 time))))) + "time" info))) + +(defun emms-player-mpd-select-song (prev-song new-song &optional consume) + "Move to the given song position. + +The amount to move is the number difference between PREV-SONG and +NEW-SONG. NEW-SONG should be a string containing a number. +PREV-SONG may be either a string containing a number or nil, +which indicates that we should start from the beginning of the +buffer and move to NEW-SONG. When CONSUME is non-nil, delete PREV-SONG +from the playlist." + (with-current-emms-playlist + ;; move to current track + (goto-char (if (and (stringp prev-song) + emms-playlist-selected-marker + (marker-position emms-playlist-selected-marker)) + emms-playlist-selected-marker + (point-min))) + ;; seek forward or backward + (let ((diff (if (stringp prev-song) + (- (string-to-number new-song) + (string-to-number prev-song)) + (string-to-number new-song)))) + (when consume + (emms-playlist-mode-kill-track) + (when (> diff 0) + (setq diff (1- diff)))) + (condition-case nil + (progn + ;; skip to first track if not on one + (when (and (> diff 0) + (not (emms-playlist-track-at (point)))) + (emms-playlist-next)) + + ;; move to new track + (while (> diff 0) + (emms-playlist-next) + (setq diff (- diff 1))) + (while (< diff 0) + (emms-playlist-previous) + (setq diff (+ diff 1))) + ;; select track at point + (emms-playlist-select (point))) + (error (concat "Could not move to position " new-song)))))) + +(defun emms-player-mpd-sync-from-emms-1 (closure) + (emms-player-mpd-get-playlist-id + closure + (lambda (closure id) + (let ((buffer (car closure)) + (fn (cdr closure))) + (when (functionp fn) + (funcall fn buffer id)))))) + +(defun emms-player-mpd-sync-from-emms (&optional callback) + "Synchronize the MusicPD playlist with the contents of the +current EMMS playlist. + +If CALLBACK is provided, call it with the current EMMS playlist +buffer and MusicPD playlist ID when we are done, if there were no +errors." + (emms-player-mpd-clear) + (with-current-emms-playlist + (let (tracks) + (save-excursion + (setq tracks (nreverse + (emms-playlist-tracks-in-region + (point-min) (point-max))))) + (emms-player-mpd-add-several-tracks + tracks + (cons (current-buffer) callback) + #'emms-player-mpd-sync-from-emms-1)))) + +(defun emms-player-mpd-sync-from-mpd-2 (closure info) + (let ((buffer (car closure)) + (fn (cadr closure)) + (close (cddr closure)) + (id (emms-player-mpd-get-playlist-id nil #'ignore info)) + (song (emms-player-mpd-get-current-song nil #'ignore info))) + (when (buffer-live-p buffer) + (let ((emms-playlist-buffer buffer)) + (with-current-emms-playlist + (setq emms-player-mpd-playlist-id id) + (set-buffer-modified-p nil) + (if song + (emms-player-mpd-select-song nil song) + (goto-char (point-min))))) + (when (functionp fn) + (funcall fn close info))))) + +(defun emms-player-mpd-sync-from-mpd-1 (closure tracks) + (let ((buffer (car closure))) + (when (and tracks + (buffer-live-p buffer)) + (let ((emms-playlist-buffer buffer)) + (with-current-emms-playlist + (emms-playlist-clear) + (mapc #'emms-playlist-insert-track tracks))) + (emms-player-mpd-get-status closure + #'emms-player-mpd-sync-from-mpd-2)))) + +(defun emms-player-mpd-sync-from-mpd (&optional closure callback) + "Synchronize the EMMS playlist with the contents of the current +MusicPD playlist. Namely, clear the EMMS playlist buffer and add +tracks to it that are present in the MusicPD playlist. + +If the current buffer is an EMMS playlist buffer, make it the +main EMMS playlist buffer." + (when (and emms-playlist-buffer-p + (not (eq (current-buffer) emms-playlist-buffer))) + (emms-playlist-set-playlist-buffer (current-buffer))) + (with-current-emms-playlist + (emms-player-mpd-get-tracks + (cons emms-playlist-buffer (cons callback closure)) + #'emms-player-mpd-sync-from-mpd-1))) + +(defun emms-player-mpd-detect-song-change-2 (state info) + "Perform post-sync tasks after returning from a stop." + (setq emms-player-mpd-current-status nil + emms-player-playing-p 'emms-player-mpd + emms-player-paused-p (string= state "pause")) + (emms-player-mpd-detect-song-change info)) + +(defun emms-player-mpd-detect-song-change-1 (closure info) + (ignore closure) + (let ((last-id (emms-player-mpd-get-current-songid nil #'ignore emms-player-mpd-current-status)) + (current-id (emms-player-mpd-get-current-songid nil #'ignore info)) + (last-pos (emms-player-mpd-get-current-song nil #'ignore emms-player-mpd-current-status)) + (current-pos (emms-player-mpd-get-current-song nil #'ignore info)) + (state (emms-player-mpd-get-mpd-state nil #'ignore info)) + (time (emms-player-mpd-get-playing-time nil #'ignore info)) + (err-msg (cdr (assoc "error" info)))) + (if (stringp err-msg) + (progn + (message "MusicPD error: %s" err-msg) + (emms-player-mpd-send + "clearerror" + nil #'ignore)) + + (cond + ((string= state "stop") + (if current-pos + ;; a track remains: the user probably stopped MusicPD + ;; manually, so we'll stop EMMS completely + (let ((emms-player-stopped-p t)) + (setq emms-player-mpd-last-state "stop") + (emms-player-stopped)) + ;; no more tracks are left: we probably ran out of things + ;; to play, so let EMMS do something further if it wants + (unless (string= emms-player-mpd-last-state "stop") + (setq emms-player-mpd-last-state "stop") + (emms-player-stopped)))) + + ((and emms-player-mpd-last-state + (string= emms-player-mpd-last-state "stop")) + ;; resume from a stop that occurred outside of EMMS + (setq emms-player-mpd-last-state nil) + (emms-player-mpd-sync-from-mpd + state + #'emms-player-mpd-detect-song-change-2)) + + ((string= state "pause") nil) + + ((string= state "play") + (setq emms-player-mpd-last-state "play") + (unless (or (null current-id) + (and (stringp last-id) + (string= current-id last-id))) + (let ((emms-player-stopped-p t)) + (emms-player-stopped)) + (emms-player-mpd-select-song + last-pos current-pos + (and emms-player-mpd-current-status + (string= "1" (emms-player-mpd-get-current-consume nil #'ignore emms-player-mpd-current-status)) + (string= "play" (emms-player-mpd-get-mpd-state nil #'ignore emms-player-mpd-current-status)) + (stringp current-id) (stringp last-id) + (not (string= current-id last-id)))) + (emms-player-started 'emms-player-mpd) + (when time + (run-hook-with-args 'emms-player-time-set-functions + time)))))) + (setq emms-player-mpd-current-status info))) + +(defun emms-player-mpd-detect-song-change (&optional info) + "Detect whether a song change has occurred. +This is usually called by a timer. + +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD." + (if info + (emms-player-mpd-detect-song-change-1 nil info) + (emms-player-mpd-get-status nil #'emms-player-mpd-detect-song-change-1))) + +(defun emms-player-mpd-quote-file (file) + "Escape special characters in FILE and surround in double-quotes." + (concat "\"" + (emms-replace-regexp-in-string + "\"" "\\\\\"" + (emms-replace-regexp-in-string "\\\\" "\\\\\\\\" file)) + "\"")) + +;;;###autoload +(defun emms-player-mpd-clear () + "Clear the MusicPD playlist." + (interactive) + (when emms-player-mpd-status-timer + (emms-cancel-timer emms-player-mpd-status-timer) + (setq emms-player-mpd-status-timer nil)) + (setq emms-player-mpd-last-state nil) + (emms-player-mpd-send "clear" nil #'ignore) + (let ((emms-player-stopped-p t)) + (emms-player-stopped))) + +;;; Adding to the MusicPD playlist + +(defun emms-player-mpd-add-file (file closure callback) + "Add FILE to the current MusicPD playlist. +Execute CALLBACK with CLOSURE as its first argument when done. + +If an error occurs, display a relevant message." + (setq file (emms-player-mpd-get-mpd-filename file)) + (emms-player-mpd-send + (concat "add " (emms-player-mpd-quote-file file)) + (cons file (cons callback closure)) + (lambda (closure response) + (let ((output (emms-player-mpd-parse-response response)) + (file (car closure)) + (callback (cadr closure)) + (close (cddr closure))) + (if (car output) + (message "MusicPD error: %s: %s" file (cdar output)) + (when (functionp callback) + (funcall callback close))))))) + +(defun emms-player-mpd-add-buffer-contents (buffer closure callback) + "Load contents of BUFFER into MusicPD by adding each line. +Execute CALLBACK with CLOSURE as its first argument when done. + +This handles both m3u and pls type playlists." + (with-current-buffer buffer + (goto-char (point-min)) + (let ((format (emms-source-playlist-determine-format))) + (when format + (emms-player-mpd-add-several-files + (emms-source-playlist-files format) + closure callback))))) + +(defun emms-player-mpd-add-playlist (playlist closure callback) + "Load contents of PLAYLIST into MusicPD by adding each line. +Execute CALLBACK with CLOSURE as its first argument when done. + +This handles both m3u and pls type playlists." + ;; This is useful for playlists of playlists + (with-temp-buffer + (emms-insert-file-contents playlist) + (emms-player-mpd-add-buffer-contents (current-buffer) closure callback))) + +(defun emms-player-mpd-add-streamlist (url closure callback) + "Download contents of URL and then add its feeds into MusicPD. +Execute CALLBACK with CLOSURE as its first argument when done." + ;; This is useful with emms-streams.el + (if (fboundp 'url-insert-file-contents) + (progn + (require 'emms-url) + (with-temp-buffer + (url-insert-file-contents (emms-url-quote-entire url)) + (emms-http-decode-buffer (current-buffer)) + (emms-player-mpd-add-buffer-contents (current-buffer) + closure callback))) + (error (message (concat "You need to install url.el so that" + " Emms can retrieve this stream"))))) + +(defun emms-player-mpd-add (track closure callback) + "Add TRACK to the MusicPD playlist. +Execute CALLBACK with CLOSURE as its first argument when done." + (let ((name (emms-track-get track 'name)) + (type (emms-track-get track 'type))) + (cond ((eq type 'url) + (emms-player-mpd-add-file name closure callback)) + ((eq type 'streamlist) + (emms-player-mpd-add-streamlist name closure callback)) + ((or (eq type 'playlist) + (string-match "\\.\\(m3u\\|pls\\)\\'" name)) + (emms-player-mpd-add-playlist name closure callback)) + ((and (eq type 'file) + (string-match emms-player-mpd-supported-regexp name)) + (emms-player-mpd-add-file name closure callback))))) + +(defun emms-player-mpd-add-several-tracks (tracks closure callback) + "Add TRACKS to the MusicPD playlist. +Execute CALLBACK with CLOSURE as its first argument when done." + (when (consp tracks) + (while (cdr tracks) + (emms-player-mpd-add (car tracks) nil #'ignore) + (setq tracks (cdr tracks))) + ;; only execute callback on last track + (emms-player-mpd-add (car tracks) closure callback))) + +(defun emms-player-mpd-add-several-files (files closure callback) + "Add FILES to the MusicPD playlist. +Execute CALLBACK with CLOSURE as its first argument when done." + (when (consp files) + (while (cdr files) + (emms-player-mpd-add-file (car files) nil #'ignore) + (setq files (cdr files))) + ;; only execute callback on last file + (emms-player-mpd-add-file (car files) closure callback))) + +;;; EMMS API + +(defun emms-player-mpd-playable-p (track) + "Return non-nil when we can play this track." + (and (memq (emms-track-type track) '(file url playlist streamlist)) + (string-match (emms-player-get emms-player-mpd 'regex) + (emms-track-name track)) + (condition-case nil + (progn (emms-player-mpd-ensure-process) + t) + (error nil)))) + +(defun emms-player-mpd-play (&optional id) + "Play whatever is in the current MusicPD playlist. +If ID is specified, play the song at that position in the MusicPD +playlist." + (interactive) + (if id + (progn + (unless (stringp id) + (setq id (number-to-string id))) + (emms-player-mpd-send + (concat "play " id) + nil + (lambda (closure response) + (ignore closure response) + (setq emms-player-mpd-current-status nil) + (if emms-player-mpd-check-interval + (setq emms-player-mpd-status-timer + (run-at-time t emms-player-mpd-check-interval + #'emms-player-mpd-detect-song-change)) + (emms-player-mpd-detect-song-change))))) + ;; we only want to play one track, so don't start the timer + (emms-player-mpd-send + "play" + nil + (lambda (closure response) + (ignore closure response) + (emms-player-started 'emms-player-mpd))))) + +(defun emms-player-mpd-start-and-sync-2 (buffer id) + (when (buffer-live-p buffer) + (let ((emms-playlist-buffer buffer)) + (with-current-emms-playlist + (setq emms-player-mpd-playlist-id id) + (set-buffer-modified-p nil) + (let ((track-cnt 0)) + (save-excursion + (goto-char + (if (and emms-playlist-selected-marker + (marker-position emms-playlist-selected-marker)) + emms-playlist-selected-marker + (point-min))) + (condition-case nil + (while t + (emms-playlist-previous) + (setq track-cnt (1+ track-cnt))) + (error nil))) + (emms-player-mpd-play track-cnt)))))) + +(defun emms-player-mpd-start-and-sync-1 (closure id) + (ignore closure) + (let ((buf-id (with-current-emms-playlist + emms-player-mpd-playlist-id))) + (if (and (not (buffer-modified-p emms-playlist-buffer)) + (stringp buf-id) + (string= buf-id id)) + (emms-player-mpd-start-and-sync-2 emms-playlist-buffer id) + (emms-player-mpd-sync-from-emms + #'emms-player-mpd-start-and-sync-2)))) + +(defun emms-player-mpd-start-and-sync () + "Ensure that MusicPD's playlist is up-to-date with EMMS's +playlist, and then play the current track. + +This is called if `emms-player-mpd-sync-playlist' is non-nil." + (when emms-player-mpd-status-timer + (emms-cancel-timer emms-player-mpd-status-timer) + (setq emms-player-mpd-status-timer nil)) + (emms-player-mpd-send + "clearerror" + nil + (lambda (closure response) + (ignore closure response) + (emms-player-mpd-get-playlist-id + nil + #'emms-player-mpd-start-and-sync-1)))) + +(defun emms-player-mpd-connect-1 (closure info) + (ignore closure) + (setq emms-player-mpd-current-status nil) + (let* ((state (emms-player-mpd-get-mpd-state nil #'ignore info))) + (unless (string= state "stop") + (setq emms-player-playing-p 'emms-player-mpd)) + (when (string= state "pause") + (setq emms-player-paused-p t)) + (unless (string= state "stop") + (emms-player-mpd-detect-song-change info) + (when emms-player-mpd-check-interval + (setq emms-player-mpd-status-timer + (run-at-time t emms-player-mpd-check-interval + #'emms-player-mpd-detect-song-change)))))) + +;;;###autoload +(defun emms-player-mpd-connect () + "Connect to MusicPD and retrieve its current playlist. + +Afterward, the status of MusicPD will be tracked. + +This also has the effect of changing the current EMMS playlist to +be the same as the current MusicPD playlist. Thus, this +function is useful to call if the contents of the EMMS playlist +buffer get out-of-sync for some reason." + (interactive) + (when emms-player-mpd-status-timer + (emms-cancel-timer emms-player-mpd-status-timer) + (setq emms-player-mpd-status-timer nil)) + (emms-player-mpd-sync-from-mpd + nil #'emms-player-mpd-connect-1)) + +(defun emms-player-mpd-start (track) + "Starts a process playing TRACK." + (interactive) + (if (and emms-player-mpd-sync-playlist + (not (memq (emms-track-get track 'type) '(streamlist playlist)))) + (emms-player-mpd-start-and-sync) + (emms-player-mpd-clear) + ;; if we have loaded the item successfully, play it + (emms-player-mpd-add track nil #'emms-player-mpd-play))) + +(defun emms-player-mpd-disconnect (&optional no-stop) + "Terminate the MusicPD client process and disconnect from MusicPD. + +If NO-STOP is non-nil, do not indicate to EMMS that we are +stopped. This argument is meant to be used when calling this +from other functions." + (interactive) + (emms-cancel-timer emms-player-mpd-status-timer) + (setq emms-player-mpd-status-timer nil + emms-player-mpd-current-status nil + emms-player-mpd-last-state nil) + (emms-player-mpd-close-process) + (unless no-stop + (let ((emms-player-stopped-p t)) + (emms-player-stopped)))) + +(defun emms-player-mpd-stop () + "Stop the currently playing song." + (interactive) + (condition-case nil + (emms-player-mpd-send "stop" nil #'ignore) + (error nil)) + (emms-player-mpd-disconnect t) + (let ((emms-player-stopped-p t)) + (emms-player-stopped))) + +(defun emms-player-mpd-pause () + "Pause the currently playing song." + (interactive) + (emms-player-mpd-send "pause" nil #'ignore)) + +(defun emms-player-mpd-seek (amount) + "Seek backward or forward by AMOUNT seconds, depending on sign of AMOUNT." + (interactive) + (emms-player-mpd-get-status + amount + (lambda (amount info) + (let ((song (emms-player-mpd-get-current-song nil #'ignore info)) + (secs (emms-player-mpd-get-playing-time nil #'ignore info))) + (when (and song secs) + (emms-player-mpd-send + (concat "seek " song " " (number-to-string (round (+ secs amount)))) + nil #'ignore)))))) + +(defun emms-player-mpd-seek-to (pos) + "Seek to POS seconds from the start of the current track." + (interactive) + (emms-player-mpd-get-current-song + pos + (lambda (pos song) + (when (and song pos) + (emms-player-mpd-send + (concat "seek " song " " (number-to-string (round pos))) + nil #'ignore))))) + +(defun emms-player-mpd-next () + "Move forward by one track in MusicPD's internal playlist." + (interactive) + (emms-player-mpd-send "next" nil #'ignore)) + +(defun emms-player-mpd-previous () + "Move backward by one track in MusicPD's internal playlist." + (interactive) + (emms-player-mpd-send "previous" nil #'ignore)) + +;;; Volume + +(defun emms-volume-mpd-change (amount) + "Change volume up or down by AMOUNT, depending on whether it is +positive or negative." + (interactive "MVolume change amount (+ increase, - decrease): ") + (emms-player-mpd-get-volume + amount + (lambda (change volume) + (let ((new-volume (+ (string-to-number volume) change))) + (emms-player-mpd-send + (concat "setvol \"" (number-to-string new-volume) "\"") + nil #'ignore))))) + +;;; Now playing + +(defun emms-player-mpd-show-1 (closure response) + (let* ((info (emms-player-mpd-get-alist + (emms-player-mpd-parse-response response))) + (insertp (car closure)) + (callback (cadr closure)) + (buffer (cddr closure)) + (name (cdr (assoc "name" info))) ; radio feeds sometimes set this + (file (cdr (assoc "file" info))) + (desc nil)) + ;; if we are playing lastfm radio, use its show function instead + (if (and (boundp 'emms-lastfm-radio-stream-url) + (stringp emms-lastfm-radio-stream-url) + (string= emms-lastfm-radio-stream-url file)) + (with-current-buffer buffer + (and (fboundp 'emms-lastfm-np) + (emms-lastfm-np insertp callback))) + ;; otherwise build and show the description + (when info + (when name + (setq desc name)) + (when file + (let ((track (emms-dictionary '*track*)) + track-desc) + (if (string-match "\\`http://" file) + (emms-track-set track 'type 'url) + (emms-track-set track 'type 'file)) + (emms-track-set track 'name file) + (emms-info-mpd track info) + (run-hook-with-args 'emms-track-info-filters track) + (setq track-desc (emms-track-description track)) + (when (and (stringp track-desc) (not (string= track-desc ""))) + (setq desc (if desc + (concat desc ": " track-desc) + track-desc)))))) + (if (not desc) + (unless (functionp callback) + (message "Nothing playing right now")) + (setq desc (format emms-show-format desc)) + (cond ((functionp callback) + (funcall callback buffer desc)) + (insertp + (when (buffer-live-p buffer) + (with-current-buffer buffer + (insert desc)))) + (t + (message "%s" desc))))))) + +;;;###autoload +(defun emms-player-mpd-show (&optional insertp callback) + "Describe the current EMMS track in the minibuffer. + +If INSERTP is non-nil, insert the description into the current +buffer instead. + +If CALLBACK is a function, call it with the current buffer and +description as arguments instead of displaying the description or +inserting it. + +This function uses `emms-show-format' to format the current track. +It differs from `emms-show' in that it asks MusicPD for the current track, +rather than EMMS." + (interactive "P") + (emms-player-mpd-send "currentsong" + (cons insertp (cons callback (current-buffer))) + #'emms-player-mpd-show-1)) + +;;; Track info + +(defun emms-info-mpd-process (track info) + (dolist (data info) + (let ((name (car data)) + (value (cdr data))) + (setq name (cond ((string= name "artist") 'info-artist) + ((string= name "composer") 'info-composer) + ((string= name "performer") 'info-performer) + ((string= name "title") 'info-title) + ((string= name "album") 'info-album) + ((string= name "track") 'info-tracknumber) + ((string= name "disc") 'info-discnumber) + ((string= name "date") 'info-year) + ((string= name "genre") 'info-genre) + ((string= name "time") + (setq value (string-to-number value)) + 'info-playing-time) + (t nil))) + (when name + (emms-track-set track name value))))) + +(defun emms-info-mpd-1 (track response) + (let ((info (emms-player-mpd-get-alist + (emms-player-mpd-parse-response response)))) + (when info + (emms-info-mpd-process track info) + (emms-track-updated track)))) + +(defun emms-info-mpd (track &optional info) + "Add track information to TRACK. +If INFO is specified, use that instead of acquiring the necessary +info from MusicPD. + +This is a useful addition to `emms-info-functions'." + (if info + (emms-info-mpd-process track info) + (when (and (emms-track-file-p track) + (not (string-match "\\`http://" (emms-track-name track)))) + (let ((file (emms-player-mpd-get-mpd-filename (emms-track-name track)))) + (when (or emms-player-mpd-music-directory + (and file + (string-match emms-player-mpd-supported-regexp file))) + (condition-case nil + (emms-player-mpd-send + (concat "find filename " + (emms-player-mpd-quote-file file)) + track + #'emms-info-mpd-1) + (error nil))))))) + +;;; Caching + +(defun emms-cache-set-from-mpd-track (track-info) + "Dump TRACK-INFO into the EMMS cache. + +The track should be an alist as per `emms-player-mpd-get-alist'." + (when emms-cache-set-function + (let ((track (emms-dictionary '*track*)) + (name (cdr (assoc "file" track-info)))) + (when name + (setq name (emms-player-mpd-get-emms-filename name)) + (emms-track-set track 'type 'file) + (emms-track-set track 'name name) + (emms-info-mpd-process track track-info) + (funcall emms-cache-set-function 'file name track))))) + +(defun emms-cache--info-cleanup (info) + (let ((xs (mapcar (lambda (x) + (and (stringp x) + (not (string-match-p "\\`\\(Last-\\|direct\\)" x)) + x)) + info))) + (cons nil (delq nil xs)))) + +(defun emms-cache-set-from-mpd-directory (dir) + "Dump all MusicPD data from DIR into the EMMS cache. + +This is useful to do when you have recently acquired new music." + (interactive + (list (if emms-player-mpd-music-directory + (emms-read-directory-name "Directory: " + emms-player-mpd-music-directory) + (read-string "Directory: ")))) + (unless (string= dir "") + (setq dir (emms-player-mpd-get-mpd-filename dir))) + (if emms-cache-set-function + (progn + (message "Dumping MusicPD data to cache...") + (emms-player-mpd-send + (concat "listallinfo " dir) + nil + (lambda (closure response) + (ignore closure response) + (message "Dumping MusicPD data to cache...processing") + (let ((info (emms-player-mpd-parse-response response))) + (when (null (car info)) + (let* ((info (emms-cache--info-cleanup info)) + (info (emms-player-mpd-get-alists info)) + (track 1) + (total (length info))) + (dolist (track-info info) + (message "Dumping MusicPD data to cache...%d/%d" track total) + (emms-cache-set-from-mpd-track track-info) + (setq track (+ 1 track))) + (message "Dumping MusicPD data to cache... %d tracks processed" + total))))))) + (error "Caching is not enabled"))) + +(defun emms-cache-set-from-mpd-all () + "Dump all MusicPD data into the EMMS cache. + +This is useful to do once, just before using emms-browser.el, in +order to prime the cache." + (interactive) + (emms-cache-set-from-mpd-directory "")) + +;;; Updating tracks + +(defun emms-player-mpd-update-directory (dir) + "Cause the tracks in DIR to be updated in the MusicPD database." + (interactive + (list (if emms-player-mpd-music-directory + (emms-read-directory-name "Directory: " + emms-player-mpd-music-directory) + (read-string "Directory: ")))) + (unless (string= dir "") + (setq dir (emms-player-mpd-get-mpd-filename dir))) + (emms-player-mpd-send + (concat "update " (emms-player-mpd-quote-file dir)) nil + (lambda (closure response) + (ignore closure) + (let ((id (cdr (assoc "updating_db" + (emms-player-mpd-get-alist + (emms-player-mpd-parse-response response)))))) + (if id + (message "Updating DB with ID %s" id) + (message "Could not update the DB")))))) + +(defun emms-player-mpd-update-all () + "Cause all tracks in the MusicPD music directory to be updated in +the MusicPD database." + (interactive) + (emms-player-mpd-update-directory "")) + +(defvar emms-player-mpd-waiting-for-update-timer nil + "Timer object when waiting for MPD update to finish.") + +(defun emms-player-mpd-update-all-reset-cache () + "Update all tracks in the MusicPD music directory. +When update finishes, clear the EMMS cache and call +`emms-cache-set-from-mpd-all' to dump the MusicPD data into the +cache." + (interactive) + (if emms-player-mpd-waiting-for-update-timer + (message "Already waiting for an update to finish.") + (emms-player-mpd-send + "update" nil + 'emms-player-mpd-wait-for-update))) + +(defun emms-player-mpd-wait-for-update (&optional closure response) + "Wait for a currently running mpd update to finish. +Afterwards, clear the EMMS cache and call +`emms-cache-set-from-mpd-all'." + (ignore closure) + (if response + ;; This is the first call after the update command + (let ((id (cdr (assoc "updating_db" + (emms-player-mpd-get-alist + (emms-player-mpd-parse-response response)))))) + (if id + (progn + (message "Updating DB with ID %s. Waiting for the update to finish..." id) + (setq emms-player-mpd-waiting-for-update-timer + (run-at-time 1 nil #'emms-player-mpd-wait-for-update))) + (message "Could not update the DB"))) + ;; Otherwise, check if update is still in progress + (emms-player-mpd-get-status-part + nil + (lambda (closure updating) + (ignore closure) + (if updating + ;; MPD update still in progress, so wait another second + (run-at-time 1 nil #'emms-player-mpd-wait-for-update) + ;; MPD update finished + (setq emms-player-mpd-waiting-for-update-timer nil) + (message "MPD update finished.") + (sit-for 1) + (clrhash emms-cache-db) + (emms-cache-set-from-mpd-all))) + "updating_db"))) + + +(provide 'emms-player-mpd) + +;;; emms-player-mpd.el ends here diff --git a/elisp/emms-player-mpg321-remote.el b/elisp/emms-player-mpg321-remote.el new file mode 100644 index 0000000..43f2d7b --- /dev/null +++ b/elisp/emms-player-mpg321-remote.el @@ -0,0 +1,225 @@ +;;; emms-player-mpg321-remote.el --- play files with mpg321 -R -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2021 Free Software Foundation, Inc. + +;; Author: Damien Elmes +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file provides an emms-player which uses mpg321's remote mode +;; to play files. This is a persistent process which isn't killed each +;; time a new file is played. + +;; The remote process copes graciously with errors in music files, and +;; allows you to seek in files. + +;; To enable this code, add the following to your emacs configuration: + +;; (require 'emms-player-mpg321-remote) +;; (push 'emms-player-mpg321-remote emms-player-list) + +;;; Code: + +(require 'emms) +(require 'emms-player-simple) + +;; -------------------------------------------------- +;; Variables and configuration +;; -------------------------------------------------- + +(defgroup emms-player-mpg321-remote nil + "*EMMS player using mpg321's remote mode." + :group 'emms-player + :prefix "emms-player-mpg321-remote") + +(defcustom emms-player-mpg321-remote-command "mpg321" + "The command name of mpg321." + :type 'string) + +(defcustom emms-player-mpg321-remote-parameters nil + "Extra arguments to pass to mpg321 when using remote mode +For example: (list \"-o\" \"alsa\")" + :type '(repeat string)) + +(defcustom emms-player-mpg321-remote + (emms-player #'emms-player-mpg321-remote-start-playing + #'emms-player-mpg321-remote-stop-playing + #'emms-player-mpg321-remote-playable-p) + "A player for EMMS." + :type '(cons symbol alist)) + +(defvar emms-player-mpg321-remote-initial-args + (list "--skip-printing-frames=10" "-R" "-") + "Initial args to pass to the mpg321 process.") + +(defvar emms-player-mpg321-remote-process-name "emms-player-mpg321-remote-proc" + "The name of the mpg321 remote player process") + +(defvar emms-player-mpg321-remote-ignore-stop 0 + "Number of stop messages to ignore, due to user action.") + +(defmacro emms-player-mpg321-remote-add (cmd func) + `(emms-player-set 'emms-player-mpg321-remote + ,cmd ,func)) + +(emms-player-mpg321-remote-add + 'regex (emms-player-simple-regexp "mp3" "mp2")) +(emms-player-mpg321-remote-add + 'pause 'emms-player-mpg321-remote-pause) +(emms-player-mpg321-remote-add + 'resume 'emms-player-mpg321-remote-pause) +(emms-player-mpg321-remote-add + 'seek 'emms-player-mpg321-remote-seek) + +;; -------------------------------------------------- +;; Process maintenence +;; -------------------------------------------------- + +(defun emms-player-mpg321-remote-start-process () + "Start a new remote process, and return the process." + (let ((process (apply #'start-process + emms-player-mpg321-remote-process-name + nil + emms-player-mpg321-remote-command + (append emms-player-mpg321-remote-initial-args + emms-player-mpg321-remote-parameters)))) + (set-process-sentinel process #'emms-player-mpg321-remote-sentinel) + (set-process-filter process #'emms-player-mpg321-remote-filter) + process)) + +(defun emms-player-mpg321-remote-stop () + "Stop the currently playing process, if indeed there is one" + (let ((process (emms-player-mpg321-remote-process))) + (when process + (kill-process process) + (delete-process process)))) + +(defun emms-player-mpg321-remote-process () + "Return the remote process, if it exists." + (get-process emms-player-mpg321-remote-process-name)) + +(defun emms-player-mpg321-remote-running-p () + "True if the remote process exists and is running." + (let ((proc (emms-player-mpg321-remote-process))) + (and proc + (eq (process-status proc) 'run)))) + +(defun emms-player-mpg321-remote-sentinel (proc str) + "Sentinel for determining the end of process" + (ignore str) + (when (or (eq (process-status proc) 'exit) + (eq (process-status proc) 'signal)) + ;; reset + (setq emms-player-mpg321-remote-ignore-stop 0) + (message "Remote process died!"))) + +(defun emms-player-mpg321-remote-send (text) + "Send TEXT to the mpg321 remote process, and add a newline." + (let (proc) + ;; we shouldn't be trying to send to a dead process + (unless (emms-player-mpg321-remote-running-p) + (emms-player-mpg321-remote-start-process)) + (setq proc (emms-player-mpg321-remote-process)) + (process-send-string proc (concat text "\n")))) + +;; -------------------------------------------------- +;; Interfacing with emms +;; -------------------------------------------------- + +(defun emms-player-mpg321-remote-filter (proc str) + (ignore proc) + (let* ((data-lines (split-string str "\n" t)) + data + cmd) + (dolist (line data-lines) + (setq data (split-string line)) + (setq cmd (car data)) + (cond + ;; stop notice + ((and (string= cmd "@P") + (or (string= (cadr data) "0") + (string= (cadr data) "3"))) + (emms-player-mpg321-remote-notify-emms)) + ;; frame notice + ((string= cmd "@F") + ;; even though a timer is constantly updating this variable, + ;; updating it here will cause it to stay pretty much in sync. + (run-hook-with-args 'emms-player-time-set-functions + (truncate (string-to-number (nth 3 data))))))))) + +(defun emms-player-mpg321-remote-start-playing (track) + "Start playing a song by telling the remote process to play it. +If the remote process is not running, launch it." + (unless (emms-player-mpg321-remote-running-p) + (emms-player-mpg321-remote-start-process)) + (emms-player-mpg321-remote-play-track track)) + +(defvar emms-player-ignore-stop) + +(defun emms-player-mpg321-remote-notify-emms (&optional user-action) + "Tell emms that the current song has finished. +If USER-ACTION, set `emms-player-mpg321-remote-ignore-stop' so that we +ignore the next message from mpg321." + (if user-action + (let ((emms-player-ignore-stop t)) + ;; so we ignore the next stop message + (setq emms-player-mpg321-remote-ignore-stop + (1+ emms-player-mpg321-remote-ignore-stop)) + (emms-player-stopped)) + ;; not a user action + (if (not (zerop emms-player-mpg321-remote-ignore-stop)) + (setq emms-player-mpg321-remote-ignore-stop + (1- emms-player-mpg321-remote-ignore-stop)) + (emms-player-stopped)))) + +(defun emms-player-mpg321-remote-stop-playing () + "Stop the current song playing." + (emms-player-mpg321-remote-notify-emms t) + (emms-player-mpg321-remote-send "stop")) + +(defun emms-player-mpg321-remote-play-track (track) + "Send a play command to the remote, based on TRACK." + (emms-player-mpg321-remote-send + (concat "load " (emms-track-get track 'name))) + (emms-player-started 'emms-player-mpg321-remote)) + +(defun emms-player-mpg321-remote-playable-p (track) + ;; use the simple definition. + (emms-player-mpg321-playable-p track)) + +(defun emms-player-mpg321-remote-pause () + "Pause the player." + (emms-player-mpg321-remote-send "pause")) + +(defun emms-player-mpg321-remote-resume () + "Resume the player." + (emms-player-mpg321-remote-send "pause")) + +(defun emms-player-mpg321-remote-seek (seconds) + "Seek forward or backward in the file." + ;; since mpg321 only supports seeking by frames, not seconds, we + ;; make a very rough guess as to how much a second constitutes + (let ((frame-string (number-to-string (* 35 seconds)))) + ;; if we're not going backwards, we need to add a '+' + (unless (eq ?- (string-to-char frame-string)) + (setq frame-string (concat "+" frame-string))) + (emms-player-mpg321-remote-send (concat "jump " frame-string)))) + +(provide 'emms-player-mpg321-remote) +;;; emms-player-mpg321-remote.el ends here diff --git a/elisp/emms-player-mplayer.el b/elisp/emms-player-mplayer.el new file mode 100644 index 0000000..0ce0a19 --- /dev/null +++ b/elisp/emms-player-mplayer.el @@ -0,0 +1,81 @@ +;;; emms-player-mplayer.el --- mplayer support for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Authors: William Xu +;; Jorgen Schaefer + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This provides a player that uses mplayer. It supports pause and +;; seeking. For loading subtitles automatically, try adding +;; "sub-fuzziness=1" to your `~/.mplayer/config', see mplayer manual for +;; more. + +;;; Code: + +(require 'emms-compat) +(require 'emms-player-simple) + +(define-emms-simple-player mplayer '(file url) + (concat "\\`\\(http[s]?\\|mms\\)://\\|" + (apply #'emms-player-simple-regexp + emms-player-base-format-list)) + "mplayer" "-slave" "-quiet" "-really-quiet") + +(define-emms-simple-player mplayer-playlist '(streamlist) + "\\`http[s]?://" + "mplayer" "-slave" "-quiet" "-really-quiet" "-playlist") + +(emms-player-set emms-player-mplayer + 'pause + 'emms-player-mplayer-pause) + +;;; Pause is also resume for mplayer +(emms-player-set emms-player-mplayer + 'resume + nil) + +(emms-player-set emms-player-mplayer + 'seek + 'emms-player-mplayer-seek) + +(emms-player-set emms-player-mplayer + 'seek-to + 'emms-player-mplayer-seek-to) + +(defun emms-player-mplayer-pause () + "Depends on mplayer's -slave mode." + (process-send-string + emms-player-simple-process-name "pause\n")) + +(defun emms-player-mplayer-seek (sec) + "Depends on mplayer's -slave mode." + (process-send-string + emms-player-simple-process-name + (format "seek %d\n" sec))) + +(defun emms-player-mplayer-seek-to (sec) + "Depends on mplayer's -slave mode." + (process-send-string + emms-player-simple-process-name + (format "seek %d 2\n" sec))) + +(provide 'emms-player-mplayer) +;;; emms-player-mplayer.el ends here diff --git a/elisp/emms-player-mpv.el b/elisp/emms-player-mpv.el new file mode 100644 index 0000000..4b7b908 --- /dev/null +++ b/elisp/emms-player-mpv.el @@ -0,0 +1,915 @@ +;;; emms-player-mpv.el --- mpv support for EMMS -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2018-2022 Free Software Foundation, Inc. + +;; Authors: Mike Kazantsev + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; +;; This code provides EMMS backend for using mpv player. +;; +;; It works in one of two modes, depending on `emms-player-mpv-ipc-method' +;; customizable value or installed mpv version: +;; +;; - Using long-running mpv instance and JSON IPC interface to switch tracks +;; and receive player feedback/metadata - for mpv 0.7.0 2014-10-16 and later. +;; +;; - Starting new mpv instance for each track, using its exit +;; as "next track" signal and --input-file interface for pause/seek. +;; Used as a fallback for any older mpv versions (supported in all of them). +;; +;; In default configuration, mpv will read its configuration files +;; (see its manpage for locations), and can display window for +;; video, subtitles, album-art or audio visualization. +;; +;; Useful `emms-player-mpv-parameters' tweaks: +;; +;; - Ignore config file(s): (add-to-list 'emms-player-mpv-parameters "--no-config") +;; - Disable vo window: (add-to-list 'emms-player-mpv-parameters "--vo=null") +;; - Show simple cqt visualizer window: +;; (add-to-list 'emms-player-mpv-parameters +;; "--lavfi-complex=[aid1]asplit[ao][a]; [a]showcqt[vo]") +;; +;; See "M-x customize-group emms-player-mpv" and mpv manpage for more options. +;; +;; See `emms-player-mpv-event-connect-hook' and `emms-player-mpv-event-functions', +;; as well as `emms-player-mpv-ipc-req-send' for handling more mpv events, +;; processing more playback info and metadata from it, as well as extending +;; control over its vast functionality. +;; + +;;; Code: + + +(require 'emms) +(require 'emms-player-simple) +(require 'emms-playing-time) +(require 'json) +(require 'cl-lib) + + +(defgroup emms-player-mpv nil + "EMMS player for mpv." + :group 'emms-player + :prefix "emms-player-mpv-") + +(defcustom emms-player-mpv + (emms-player + #'emms-player-mpv-start + #'emms-player-mpv-stop + #'emms-player-mpv-playable-p) + "*Parameters for mpv player." + :type '(cons symbol alist)) + +(emms-player-set emms-player-mpv 'regex + (apply #'emms-player-simple-regexp emms-player-base-format-list)) + +(defcustom emms-player-mpv-command-name "mpv" + "mpv binary to use. Can be absolute path or just binary name." + :type 'file) + +(defcustom emms-player-mpv-parameters + '("--quiet" "--really-quiet" "--no-audio-display") + "Extra command-line arguments for started mpv process(es). +Either a list of strings or function returning such list. +Extra arguments --idle and --input-file/--input-ipc-server +are added automatically, depending on mpv version. +Note that unless --no-config option is specified here, +mpv will also use options from its configuration files. +For mpv binary path, see `emms-player-mpv-command-name'." + :type '(choice (repeat :tag "List of mpv arguments" string) + function)) + +(defcustom emms-player-mpv-environment () + "List of extra environment variables (\"VAR=value\" strings) to pass on to +mpv process. + +These are added on top of `process-environment' by default. +Adding nil as an element to this list will discard emacs +`process-environment' and only pass variables that are specified +in the list." + :type '(repeat (choice string (const :tag "Start from blank environment" nil)))) + +(defcustom emms-player-mpv-ipc-method nil + "Switch for which IPC method to use with mpv. +Possible symbols: detect, ipc-server, unix-socket, file. +Defaults to nil value, which will cause `emms-player-mpv-ipc-detect\\=' +to pick one based on mpv --version output. +Using JSON-IPC variants (ipc-server and unix-socket) enables +support for various feedback and metadata options from mpv. +Use of \\='file value here is deprecated and will be removed in the future." + :type '(choice + (const :tag "Auto-detect from mpv --version" nil) + (const :tag "Use --input-ipc-server JSON IPC (v0.17.0 2016-04-11)" ipc-server) + (const :tag "Use --input-unix-socket JSON IPC (v0.7.0 2014-10-16)" unix-socket) + (const :tag "Use --input-file FIFO (removed in v0.33.0 2020-11-22)" file))) + +(defcustom emms-player-mpv-ipc-socket + (concat (file-name-as-directory emms-directory) + "mpv-ipc.sock") + "Unix IPC socket or FIFO to use with mpv --input-* options, +depending on `emms-player-mpv-ipc-method' value and/or mpv version." + :type 'file) + +(defvar emms-player-mpv-ipc-proc nil) ; to avoid warnings while keeping useful defs at the top + +(defcustom emms-player-mpv-update-duration t + "Update track duration when played by mpv. +Uses `emms-player-mpv-event-functions' hook." + :type 'boolean + :set (lambda (sym value) + (set-default-toplevel-value sym value) + (run-at-time 0.1 nil + (lambda (value) + (if value + (add-hook + 'emms-player-mpv-event-functions + #'emms-player-mpv-info-duration-event-func) + (remove-hook + 'emms-player-mpv-event-functions + #'emms-player-mpv-info-duration-event-func))) + value))) + +(defcustom emms-player-mpv-update-metadata nil + "Update track info (artist, album, name, etc) from mpv events, when it +is played. + +This allows to dynamically update stream info from ICY tags, for +example. Uses `emms-player-mpv-event-connect-hook' and +`emms-player-mpv-event-functions' hooks." + :type 'boolean + :set (lambda (sym value) + (set-default-toplevel-value sym value) + (run-at-time 0.1 nil + (lambda (value) + (if value + (progn + (add-hook + 'emms-player-mpv-event-connect-hook + #'emms-player-mpv-info-meta-connect-func) + (add-hook + 'emms-player-mpv-event-functions + #'emms-player-mpv-info-meta-event-func) + (when (process-live-p emms-player-mpv-ipc-proc) + (emms-player-mpv-info-meta-connect-func))) + (progn + (remove-hook + 'emms-player-mpv-event-connect-hook + #'emms-player-mpv-info-meta-connect-func) + (remove-hook + 'emms-player-mpv-event-functions + #'emms-player-mpv-info-meta-event-func)))) + value))) + +(defcustom emms-player-mpv-use-playlist-option nil + "Use --playlist option and loadlist mpv command for playlist files and URLs. + +Use of this option is explicitly discouraged by mpv documentation for security +reasons, and should be unnecessary in most common cases with modern mpv. +Make sure to check mpv manpage for --playlist option before enabling this." + :type 'boolean) + + +(defvar emms-player-mpv-proc nil + "Running mpv process, controlled over --input-ipc-server/--input-file sockets.") + +(defvar emms-player-mpv-proc-kill-delay 5 + "Delay until SIGKILL gets sent to `emms-player-mpv-proc', +if it refuses to exit cleanly on `emms-player-mpv-proc-stop'.") + + +(defvar emms-player-mpv-ipc-proc nil + "Unix socket network process connected to running `emms-player-mpv-proc' +instance.") + +(defvar emms-player-mpv-ipc-buffer " *emms-player-mpv-ipc*" + "Buffer to associate with `emms-player-mpv-ipc-proc' socket/pipe process.") + +(defvar emms-player-mpv-ipc-connect-timer nil + "Timer for connection attempts to JSON IPC unix socket.") +(defvar emms-player-mpv-ipc-connect-delays + '(0.1 0.1 0.1 0.1 0.1 0.1 0.2 0.2 0.3 0.3 0.5 1.0 1.0 2.0) + "List of delays before initiating socket connection for new mpv process.") + +(defvar emms-player-mpv-ipc-connect-command nil + "JSON command for `emms-player-mpv-ipc-sentinel' to run when it connects to mpv. +I.e. last command that either initiated connection or was used while +connecting to mpv. +Set by `emms-player-mpv-start' and such, +cleared once it gets sent by `emms-player-mpv-ipc-sentinel'.") + +(defvar emms-player-mpv-ipc-id 1 + "Auto-incremented counter for unique JSON request identifiers. +Use for for `request_id' and `observe_property' identifiers. +Use `emms-player-mpv-ipc-id-get' to get and increment this value, +instead of using it directly. +Wraps-around upon reaching `emms-player-mpv-ipc-id-max' +(unlikely to ever happen).") + +(defvar emms-player-mpv-ipc-id-max (expt 2 30) + "Max value for `emms-player-mpv-ipc-id' to wrap around after. +Should be fine with both mpv and Emacs, and probably never reached anyway.") + +(defvar emms-player-mpv-ipc-req-table nil + "Auto-initialized hash table of outstanding API req_ids to their handler funcs.") + +(defvar emms-player-mpv-ipc-stop-command nil + "Internal flag to track when stop command starts/finishes before next loadfile. +Set to either nil, t or the playback start function to call on end-file event +after stop command. +This is a workaround for mpv-0.30+ behavior, where \\='stop + loadfile\\=' only +runs \\='stop\\='.") + + +(defvar emms-player-mpv-event-connect-hook nil + "Normal hook run right after establishing new JSON IPC connection to mpv. +Runs before `emms-player-mpv-ipc-connect-command\\=', if any. +Best place to send any `observe_property\\=', `request_log_messages\\=', +`enable_event\\=' commands. +Use `emms-player-mpv-ipc-id-get\\=' to get unique id values for these. +See also `emms-player-mpv-event-functions\\='.") + +(defvar emms-player-mpv-event-functions nil + "List of functions to call for each event emitted from JSON IPC. +One argument is passed to each function - JSON line, +as sent by mpv and decoded by `json-read-from-string\\='. +See also `emms-player-mpv-event-connect-hook\\='.") + + +(defvar emms-player-mpv-stopped nil + "Non-nil if playback was stopped by call from emms. +Similar to `emms-player-stopped-p\\=', but set for future async events, +to indicate that playback should stop instead of switching to next track.") + +(defvar emms-player-mpv-idle-timer (timer-create) + "Timer to delay `emms-player-stopped\\=' when mpv unexpectedly goes idle.") + +(defvar emms-player-mpv-idle-delay 0.5 + "Delay before issuing `emms-player-stopped\\=' when mpv unexpectedly goes idle.") + + +(defvar emms-player-mpv-ipc-conn-emacs-26.1-workaround + (and (= emacs-major-version 26) + (= emacs-minor-version 1)) + "Non-nil to enable workaround for issue #31901 in emacs 26.1. +Emacs 26.1 fails to indicate missing socket file error for unix socket +network processes that were started with :nowait t, so blocking connections +are used there instead.") + + +;; ----- helpers + +(defvar emms-player-mpv-debug nil + "Enable to print sent/received JSON lines and process +start/stop events to *Messages* buffer using `emms-player-mpv-debug-msg\\='.") + +(defvar emms-player-mpv-debug-ts-offset nil + "Timestamp offset for `emms-player-mpv-debug-msg\\='. +Set on first use, with intent to both shorten and obfuscate time in logs.") + +(defun emms-player-mpv-debug-trim (s) + (if (stringp s) + (replace-regexp-in-string "\\(^[ \t\n\r]+\\|[ \t\n\r]+$\\)" "" s t t) + s)) + +(defun emms-player-mpv-debug-msg (tpl-or-msg &rest tpl-values) + "Print debug message to *Messages* if `emms-player-mpv-debug\\=' is non-nil. +Message is only formatted if TPL-VALUES is non-empty. +Strips whitespace from start/end of TPL-OR-MSG and strings in TPL-VALUES." + (when emms-player-mpv-debug + (setq + tpl-or-msg (emms-player-mpv-debug-trim tpl-or-msg) + tpl-values (seq-map #'emms-player-mpv-debug-trim tpl-values)) + (unless tpl-values + (setq tpl-or-msg (replace-regexp-in-string "%" "%%" tpl-or-msg t t))) + (let ((ts (float-time))) + (unless emms-player-mpv-debug-ts-offset (setq emms-player-mpv-debug-ts-offset ts)) + (apply #'message + (concat "emms-player-mpv %.1f " tpl-or-msg) + (- ts emms-player-mpv-debug-ts-offset) + tpl-values)))) + +(defun emms-player-mpv-ipc-fifo-p () + "Returns non-nil if --input-file fifo should be used. + +Runs `emms-player-mpv-ipc-detect\\=' to detect/set +`emms-player-mpv-ipc-method\\=' if necessary." + (unless emms-player-mpv-ipc-method + (setq emms-player-mpv-ipc-method + (emms-player-mpv-ipc-detect emms-player-mpv-command-name))) + (eq emms-player-mpv-ipc-method 'file)) + +(defun emms-player-mpv-ipc-detect (cmd) + "Run mpv --version and return symbol for best IPC method supported. +CMD should be either name of mpv binary to use or full path to it. +Return values correspond to `emms-player-mpv-ipc-method\\=' options. +Error is signaled if mpv binary fails to run." + (with-temp-buffer + (let ((exit-code (call-process cmd nil '(t t) + nil "--version"))) + (unless (zerop exit-code) + (insert (format "----- process exited with code %d -----" exit-code)) + (error (format "Failed to run mpv binary [%s]:\n%s" cmd (buffer-string)))) + (goto-char (point-min)) + (pcase + (if (re-search-forward "^mpv\\s-+\\(\\([0-9]+\\.?\\)+\\)" nil t 1) + (mapconcat (lambda (n) + (format "%03d" n)) + (seq-map 'string-to-number + (split-string (match-string-no-properties 1) + "\\." t)) + ".") + "000.000.000") + ((pred (string> "000.006.999")) + 'file) + ((pred (string> "000.016.999")) + 'unix-socket) + (_ 'ipc-server))))) + + +;; ----- mpv process + +(defun emms-player-mpv-proc-playing-p (&optional proc) + "Return whether playback in PROC or `emms-player-mpv-proc\\=' is started, +which is distinct from \\='start-command sent\\=' and \\='process is running\\=' states. +Used to signal emms via `emms-player-started\\=' and `emms-player-stopped\\=' calls." + (let ((proc (or proc emms-player-mpv-proc))) + (and proc (process-get proc 'mpv-playing)))) + +(defun emms-player-mpv-proc-playing (state &optional proc) + "Set process mpv-playing state flag for `emms-player-mpv-proc-playing-p\\='." + (let ((proc (or proc emms-player-mpv-proc))) + (when proc (process-put proc 'mpv-playing state)))) + +(defun emms-player-mpv-proc-symbol-id (sym &optional proc) + "Get unique process-specific id integer for SYM or nil if it +was already requested." + (let + ((proc (or proc emms-player-mpv-proc)) + (sym-id (intern (concat "mpv-sym-" (symbol-name sym))))) + (unless (process-get proc sym-id) + (let ((id (emms-player-mpv-ipc-id-get))) + (process-put proc sym-id id) + id)))) + +(defun emms-player-mpv-proc-init-fifo (path &optional mode) + "Create named pipe (fifo) socket for mpv --input-file PATH, if not exists +already. + +Optional MODE should be 12-bit octal integer, e.g. #o600 (safe +default). Signals error if mkfifo exits with non-zero code." + (let ((attrs (file-attributes path))) + (when + (and attrs (not (string-prefix-p "p" (nth 8 attrs)))) + (delete-file path) + (setq attrs nil)) + (unless attrs + (unless + (zerop (call-process "mkfifo" nil nil nil + (format "--mode=%o" (or mode #o600)) + path)) + (error (format "Failed to run mkfifo for mpv --input-file path: %s" path)))))) + +(defun emms-player-mpv-proc-sentinel (proc ev) + (let + ((status (process-status proc)) + (playing (emms-player-mpv-proc-playing-p proc))) + (emms-player-mpv-debug-msg + "proc[%s]: %s (status=%s, playing=%s)" proc ev status playing) + (when (and (memq status '(exit signal)) + playing) + (emms-player-stopped)))) + +(defun emms-player-mpv-proc-init (&rest media-args) + "initialize new mpv process as `emms-player-mpv-proc'. +MEDIA-ARGS are used instead of --idle, if specified." + (emms-player-mpv-proc-stop) + (unless (file-directory-p (file-name-directory emms-player-mpv-ipc-socket)) + (make-directory (file-name-directory emms-player-mpv-ipc-socket))) + (when (emms-player-mpv-ipc-fifo-p) + (emms-player-mpv-proc-init-fifo emms-player-mpv-ipc-socket)) + (let* + ((argv emms-player-mpv-parameters) + (argv (append + (list emms-player-mpv-command-name) + (if (functionp argv) + (funcall argv) + argv) + (list (format "--input-%s=%s" + emms-player-mpv-ipc-method emms-player-mpv-ipc-socket)) + (or media-args '("--idle")))) + (env emms-player-mpv-environment) + (process-environment (append + (unless (seq-some 'not env) + process-environment) + (seq-filter 'identity env)))) + (setq emms-player-mpv-proc + (make-process :name "emms-player-mpv" + :buffer nil :command argv :noquery t :sentinel #'emms-player-mpv-proc-sentinel)) + (when (emms-player-mpv-ipc-fifo-p) + (emms-player-mpv-proc-playing t)) + (emms-player-mpv-debug-msg "proc[%s]: start %s" emms-player-mpv-proc argv))) + +(defun emms-player-mpv-proc-stop () + "Stop running `emms-player-mpv-proc' instance via SIGINT, if any. + +`delete-process' (SIGKILL) timer is started if +`emms-player-mpv-proc-kill-delay' is non-nil." + (when emms-player-mpv-proc + (let ((proc emms-player-mpv-proc)) + (emms-player-mpv-debug-msg "proc[%s]: stop" proc) + (if (not (process-live-p proc)) + (delete-process proc) + (emms-player-mpv-proc-playing nil proc) + (interrupt-process proc) + (when emms-player-mpv-proc-kill-delay + (run-at-time + emms-player-mpv-proc-kill-delay nil + (lambda (proc) + (delete-process proc)) + proc)))) + (setq emms-player-mpv-proc nil))) + + +;; ----- IPC socket/fifo + +(defun emms-player-mpv-ipc-sentinel (proc ev) + (emms-player-mpv-debug-msg "ipc[%s]: %s" proc ev) + (when (memq (process-status proc) + '(open run)) + (run-hooks 'emms-player-mpv-event-connect-hook) + (when emms-player-mpv-ipc-connect-command + (let ((cmd emms-player-mpv-ipc-connect-command)) + (setq emms-player-mpv-ipc-connect-command nil) + (emms-player-mpv-ipc-req-send cmd nil proc))))) + +(defun emms-player-mpv-ipc-filter (proc s) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) + (process-mark proc)))) + (save-excursion + (goto-char (process-mark proc)) + (insert s) + (set-marker (process-mark proc) + (point))) + (if moving (goto-char (process-mark proc)))) + ;; Process/remove all complete lines of json, if any + (let ((p0 (point-min))) + (while + (progn + (goto-char p0) + (end-of-line) + (equal (following-char) + ?\n)) + (let* + ((p1 (point)) + (json (buffer-substring p0 p1))) + (delete-region p0 (+ p1 1)) + (emms-player-mpv-ipc-recv json))))))) + +(defun emms-player-mpv-ipc-connect (delays) + "Make IPC connection attempt, rescheduling if there's no socket by (car DELAYS). +(cdr DELAYS) gets passed to next connection attempt, +so it can be rescheduled further until function runs out of DELAYS values. +Sets `emms-player-mpv-ipc-proc' value to resulting process on success." + ;; Note - emacs handles missing unix socket files in different ways between versions: + ;; emacs <26 returns nil, emacs 26.1 leaves process in a stuck 'open + ;; state (see issue #31901), emacs 26.2+ sets 'file-missing status. + ;; None of these cases call sentinel function, so status must also be checked here. + (emms-player-mpv-debug-msg "ipc: connect-delay %s" (car delays)) + (let ((use-nowait (not emms-player-mpv-ipc-conn-emacs-26.1-workaround))) + (setq emms-player-mpv-ipc-proc + (condition-case nil + (make-network-process + :name "emms-player-mpv-ipc" + :family 'local + :service emms-player-mpv-ipc-socket + :nowait use-nowait + :coding '(utf-8 . utf-8) + :buffer (get-buffer-create emms-player-mpv-ipc-buffer) + :noquery t + :filter #'emms-player-mpv-ipc-filter + :sentinel #'emms-player-mpv-ipc-sentinel) + (file-error nil))) + (unless (process-live-p emms-player-mpv-ipc-proc) + (setq emms-player-mpv-ipc-proc nil)) + (when (and emms-player-mpv-ipc-proc (not use-nowait)) + (emms-player-mpv-ipc-sentinel emms-player-mpv-ipc-proc 'open))) + (when (and (not emms-player-mpv-ipc-proc) + delays) + (run-at-time (car delays) + nil #'emms-player-mpv-ipc-connect (cdr delays)))) + +(defun emms-player-mpv-ipc-connect-fifo () + "Set `emms-player-mpv-ipc-proc' to process wrapper for +writing to a named pipe (fifo) file/node or signal error." + (setq emms-player-mpv-ipc-proc + (start-process-shell-command "emms-player-mpv-input-file" nil + (format "cat > \"%s\"" (shell-quote-argument emms-player-mpv-ipc-socket)))) + (set-process-query-on-exit-flag emms-player-mpv-ipc-proc nil) + (unless emms-player-mpv-ipc-proc (error (format + "Failed to start cat-pipe to fifo: %s" emms-player-mpv-ipc-socket))) + (when emms-player-mpv-ipc-connect-command + (let ((cmd emms-player-mpv-ipc-connect-command)) + (setq emms-player-mpv-ipc-connect-command nil) + (emms-player-mpv-ipc-fifo-cmd cmd emms-player-mpv-ipc-proc)))) + +(defun emms-player-mpv-ipc-init () + "Initialize new mpv ipc socket/file process and associated state." + (emms-player-mpv-ipc-stop) + (emms-player-mpv-debug-msg "ipc: init") + (if (emms-player-mpv-ipc-fifo-p) + (emms-player-mpv-ipc-connect-fifo) + (when emms-player-mpv-ipc-connect-timer (cancel-timer emms-player-mpv-ipc-connect-timer)) + (with-current-buffer (get-buffer-create emms-player-mpv-ipc-buffer) + (erase-buffer)) + (setq + emms-player-mpv-ipc-id 1 + emms-player-mpv-ipc-req-table nil + emms-player-mpv-ipc-connect-timer nil + emms-player-mpv-ipc-connect-timer + (run-at-time (car emms-player-mpv-ipc-connect-delays) + nil + #'emms-player-mpv-ipc-connect (cdr emms-player-mpv-ipc-connect-delays))))) + +(defun emms-player-mpv-ipc-stop () + (when emms-player-mpv-ipc-proc + (emms-player-mpv-debug-msg "ipc: stop") + (delete-process emms-player-mpv-ipc-proc) + (setq emms-player-mpv-ipc-proc nil))) + +(defun emms-player-mpv-ipc () + "Return open IPC socket/fifo process or nil, (re-)starting mpv/connection +if necessary. + +Return nil when starting async process/connection, and any +follow-up command should be stored to +`emms-player-mpv-ipc-connect-command' in this case." + (unless + ;; Don't start idle processes for fifo - just ignore all ipc requests there + (and (not (process-live-p emms-player-mpv-proc)) + (emms-player-mpv-ipc-fifo-p)) + (unless (process-live-p emms-player-mpv-proc) + (emms-player-mpv-proc-init)) + (unless (process-live-p emms-player-mpv-ipc-proc) + (emms-player-mpv-ipc-init)) + (and + emms-player-mpv-ipc-proc + (memq (process-status emms-player-mpv-ipc-proc) + '(open run)) + emms-player-mpv-ipc-proc))) + + +;; ----- IPC protocol + +(defun emms-player-mpv-ipc-id-get () + "Get new connection-unique id value, tracked via `emms-player-mpv-ipc-id'." + (let ((ipc-id emms-player-mpv-ipc-id)) + (setq emms-player-mpv-ipc-id + (if (< emms-player-mpv-ipc-id emms-player-mpv-ipc-id-max) + (1+ emms-player-mpv-ipc-id) + 1)) + ipc-id)) + +(defun emms-player-mpv-ipc-req-send (cmd &optional handler proc) + "Send JSON IPC request and assign HANDLER to response for it, if any. + +CMD value is encoded via `json-encode\\='. + +HANDLER func will be called with decoded response JSON +as (handler data err), where ERR will be either nil on +\"success\", \\='connection-error or whatever is in JSON. If +HANDLER is nil, default `emms-player-mpv-ipc-req-error-printer\\=' +will be used to at least log errors. Multiple commands can be +batched in one list as \\='(batch (cmd1 . handler1) ...), in which +case common HANDLER argument is ignored. PROC can be specified +to avoid `emms-player-mpv-ipc\\=' call (e.g. from sentinel/filter +funcs)." + (dolist + (cmd-and-handler + (if (and (listp cmd) + (eq (car cmd) + 'batch)) + (cdr cmd) + `((,cmd . ,handler)))) + (cl-destructuring-bind (cmd . handler) + cmd-and-handler + (let + ((req-id (emms-player-mpv-ipc-id-get)) + (req-proc (or proc (emms-player-mpv-ipc))) + (handler (or handler #'emms-player-mpv-ipc-req-error-printer))) + (unless emms-player-mpv-ipc-req-table + (setq emms-player-mpv-ipc-req-table (make-hash-table))) + (let ((json (concat (json-encode (list :command cmd :request_id req-id)) + "\n"))) + (emms-player-mpv-debug-msg "json >> %s" json) + (condition-case _err + ;; On any disconnect, assume that mpv process is to blame and force restart. + (process-send-string req-proc json) + (error + (emms-player-mpv-proc-stop) + (funcall handler nil 'connection-error) + (setq handler nil)))) + (when handler (puthash req-id handler emms-player-mpv-ipc-req-table)))))) + +(defun emms-player-mpv-ipc-req-resolve (req-id data err) + "Run handler-func for specified req-id." + (when emms-player-mpv-ipc-req-table + (let + ((handler (gethash req-id emms-player-mpv-ipc-req-table)) + (err (if (string= err "success") + nil err))) + (remhash req-id emms-player-mpv-ipc-req-table) + (when handler (funcall handler data err))))) + +(defun emms-player-mpv-ipc-req-error-printer (_data err) + "Simple default `emms-player-mpv-ipc-req-send' handler to log +errors, if any." + (when err (message "emms-player-mpv ipc-error: %s" err))) + +(defun emms-player-mpv-ipc-recv (json) + "Handler for all JSON lines from mpv process. + +Only used with JSON IPC, never called with --input-file as +there's no feedback there." + (emms-player-mpv-debug-msg "json << %s" json) + (let* + ((json-data (json-read-from-string json)) + (req-id (alist-get 'request_id json-data)) + (ev (alist-get 'event json-data))) + (when req-id + ;; Response to command + (emms-player-mpv-ipc-req-resolve req-id + (alist-get 'data json-data) + (alist-get 'error json-data))) + (when ev + ;; mpv event + (emms-player-mpv-event-handler json-data) + (run-hook-with-args 'emms-player-mpv-event-functions json-data)))) + +(defun emms-player-mpv-ipc-fifo-cmd (cmd &optional proc) + "Send --input-file command string for older mpv versions. +PROC can be specified to avoid `emms-player-mpv-ipc' call." + (let + ((proc (or proc (emms-player-mpv-ipc))) + (cmd-line (concat (mapconcat (lambda (s) + (format "%s" s)) + cmd " ") + "\n"))) + (emms-player-mpv-debug-msg "fifo >> %s" cmd-line) + (process-send-string proc cmd-line))) + +(defun emms-player-mpv-observe-property (sym) + "Send mpv observe_property command for property identified by SYM. +Only sends command once per process, removing any +potential duplication if used for same properties from different functions." + (let ((id (emms-player-mpv-proc-symbol-id sym))) + (when id (emms-player-mpv-ipc-req-send `(observe_property ,id ,sym))))) + +(defun emms-player-mpv-event-idle () + "Delayed check for switching tracks when mpv goes idle for no good reason." + (emms-player-mpv-debug-msg "idle-check (stopped=%s)" emms-player-mpv-stopped) + (unless emms-player-mpv-stopped (emms-player-stopped))) + +(defun emms-player-mpv-event-playing-time-sync () + "Request and update `emms-playing-time' after playback +seek/restart or unpause." + (emms-player-mpv-ipc-req-send '(get_property time-pos) + #'(lambda (pos err) + (unless err (emms-playing-time-set pos))))) + +(defun emms-player-mpv-event-handler (json-data) + "Handler for supported mpv events, including property changes. + +Called before `emms-player-mpv-event-functions' and does same +thing as these hooks." + (pcase (alist-get 'event json-data) + ("playback-restart" + ;; Separate emms-player-mpv-proc-playing state is used for emms started/stopped signals, + ;; because start-file/end-file are also emitted after track-change and for playlists, + ;; and don't correspond to actual playback state. + (unless (emms-player-mpv-proc-playing-p) + (emms-player-mpv-proc-playing t) + (emms-player-started emms-player-mpv)) + (emms-player-mpv-event-playing-time-sync)) + ("pause" + (unless emms-player-paused-p + (setq emms-player-paused-p t) + (run-hooks 'emms-player-paused-hook))) + ("unpause" + (emms-player-mpv-event-playing-time-sync) + (when emms-player-paused-p + (setq emms-player-paused-p nil) + (run-hooks 'emms-player-paused-hook))) + ("end-file" + (when (emms-player-mpv-proc-playing-p) + (emms-player-mpv-proc-playing nil) + (emms-player-stopped)) + (when emms-player-mpv-ipc-stop-command + (unless (eq emms-player-mpv-ipc-stop-command t) + (funcall emms-player-mpv-ipc-stop-command)) + (setq emms-player-mpv-ipc-stop-command nil))) + ("idle" + ;; Can mean any kind of error before or during playback. + ;; Example can be access/format error, resulting in start+end without playback-restart. + (cancel-timer emms-player-mpv-idle-timer) + (setq + emms-player-mpv-idle-timer + (run-at-time emms-player-mpv-idle-delay nil #'emms-player-mpv-event-idle) + emms-player-mpv-ipc-stop-command nil)) + ("start-file" (cancel-timer emms-player-mpv-idle-timer)))) + + +;; ----- Metadata update hooks + +(defun emms-player-mpv-info-meta-connect-func () + "Hook function for `emms-player-mpv-event-connect-hook' to update +metadata from mpv." + (emms-player-mpv-observe-property 'metadata) + (emms-player-mpv-observe-property 'duration)) + +(defun emms-player-mpv-info-meta-event-func (json-data) + "Hook function for `emms-player-mpv-event-functions' to update +metadata from mpv." + (when + (and + (string= (alist-get 'event json-data) + "property-change") + (string= (alist-get 'name json-data) + "metadata")) + (let ((info-alist (alist-get 'data json-data))) + (when info-alist (emms-player-mpv-info-meta-update-track info-alist))))) + +(defun emms-player-mpv-info-meta-update-track (info-alist &optional track) + "Update TRACK with mpv metadata from INFO-ALIST. +`emms-playlist-current-selected-track' is used by default." + (mapc + (lambda (cc) + (setcar cc (intern (downcase (symbol-name (car cc)))))) + info-alist) + (cl-macrolet + ((key (k) + `(alist-get ',k info-alist)) + (set-track-info (track &rest body) + (cons 'progn + (cl-loop for (k v) + on body by 'cddr collect + `(let ((value ,v)) + (when value + (emms-track-set ,track ',(intern (format "info-%s" k)) + value))))))) + (unless track (setq track (emms-playlist-current-selected-track))) + (set-track-info track + title (or (key title) + (and (not (string= "" (key icy-title))) + (key icy-title)) + (key icy-name)) + artist (or (key artist) + (key album_artist) + (key icy-name)) + album (key album) + tracknumber (key track) + year (key date) + genre (key genre) + note (key comment)) + (emms-track-updated track))) + +(defun emms-player-mpv-info-duration-event-func (json-data) + "Hook function for `emms-player-mpv-event-functions' to update +track duration from mpv." + (when + (and + (string= (alist-get 'event json-data) "property-change") + (string= (alist-get 'name json-data) "duration")) + (let + ((duration (alist-get 'data json-data)) + (track (emms-playlist-current-selected-track))) + (when (and track (numberp duration) (> duration 0)) + (setq duration (round duration)) + (emms-track-set track 'info-playing-time duration) + (emms-track-set track 'info-playing-time-min (/ duration 60)) + (emms-track-set track 'info-playing-time-sec (% duration 60)))))) + + +;; ----- High-level EMMS interface + +(defun emms-player-mpv-cmd (cmd &optional handler) + "Send mpv command to process/connection if both are running, +or otherwise schedule start/connect and set +`emms-player-mpv-ipc-connect-command\\=' for `emms-player-mpv-ipc-sentinel\\='. +Multiple commands can be batched in one list as \\='(batch (cmd1 . handler1) ...), +in which case common HANDLER argument is ignored." + (setq emms-player-mpv-ipc-connect-command nil) + (let ((proc (emms-player-mpv-ipc))) + (if proc + (if (emms-player-mpv-ipc-fifo-p) + (emms-player-mpv-ipc-fifo-cmd cmd proc) + (emms-player-mpv-ipc-req-send cmd handler proc)) + (setq emms-player-mpv-ipc-connect-command cmd)))) + +(defmacro emms-player-mpv-cmd-prog (cmd &rest handler-body) + "Obsolete macro around `emms-player-mpv-cmd\\=' that creates handler +callback (see `emms-player-mpv-ipc-req-send\\=') from HANDLER-BODY +forms, which have following bindings: + +- mpv-cmd for CMD. +- mpv-data for response data (decoded json, nil if none). +- mpv-error for response error (nil if no error, decoded json or + \\='connection-error). + +Do not use it with new code - it will raise warnings when used +with lexical bindings, and will be removed in a future EMMS +version." + `(emms-player-mpv-cmd ,cmd (apply-partially + (lambda (mpv-cmd mpv-data mpv-error) + ,@handler-body) + ,cmd))) + +(make-obsolete 'emms-player-mpv-cmd-prog nil "Emms 7") + + +(defun emms-player-mpv-playable-p (track) + (memq (emms-track-type track) + '(file url streamlist playlist))) + +(defun emms-player-mpv-start (track) + (setq emms-player-mpv-stopped nil) + (emms-player-mpv-proc-playing nil) + (let + ((track-name (emms-track-get track 'name)) + (track-playlist-option + (and emms-player-mpv-use-playlist-option + (memq (emms-track-get track 'type) + '(streamlist playlist))))) + (if (emms-player-mpv-ipc-fifo-p) + (progn + ;; ipc-stop is to clear any buffered commands + (emms-player-mpv-ipc-stop) + (apply 'emms-player-mpv-proc-init + (if track-playlist-option + (list (concat "--playlist=" track-name)) + (list "--" track-name))) + (emms-player-started emms-player-mpv)) + (let* + ((play-cmd + `(batch + ((,(if track-playlist-option 'loadlist 'loadfile) + ,track-name replace)) + ((set pause no)))) + (start-func + ;; Try running play-cmd and retry it on connection failure, e.g. if mpv died + (apply-partially 'emms-player-mpv-cmd play-cmd + (lambda (_mpv-data mpv-error) + (when (eq mpv-error 'connection-error) + (emms-player-mpv-cmd play-cmd)))))) + (if emms-player-mpv-ipc-stop-command + (setq emms-player-mpv-ipc-stop-command start-func) + (funcall start-func)))))) + +(defun emms-player-mpv-stop () + (setq + emms-player-mpv-stopped t + emms-player-mpv-ipc-stop-command t) + (emms-player-mpv-proc-playing nil) + (emms-player-mpv-cmd `(stop)) + (emms-player-stopped)) + + +(defun emms-player-mpv-pause () + (emms-player-mpv-cmd `(set pause yes))) + +(defun emms-player-mpv-resume () + (emms-player-mpv-cmd `(set pause no))) + +(defun emms-player-mpv-seek (sec) + (emms-player-mpv-cmd `(seek ,sec relative))) + +(defun emms-player-mpv-seek-to (sec) + (emms-player-mpv-cmd `(seek ,sec absolute))) + +(emms-player-set emms-player-mpv 'pause #'emms-player-mpv-pause) +(emms-player-set emms-player-mpv 'resume #'emms-player-mpv-resume) +(emms-player-set emms-player-mpv 'seek #'emms-player-mpv-seek) +(emms-player-set emms-player-mpv 'seek-to #'emms-player-mpv-seek-to) + + +(provide 'emms-player-mpv) +;;; emms-player-mpv.el ends here diff --git a/elisp/emms-player-simple.el b/elisp/emms-player-simple.el new file mode 100644 index 0000000..ca1bc1c --- /dev/null +++ b/elisp/emms-player-simple.el @@ -0,0 +1,207 @@ +;;; emms-player-simple.el --- A generic simple player. -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2021 Free Software Foundation, Inc. + +;; Authors: Ulrik Jensen +;; Jorgen Schäfer +;; Keywords: emms, mpg321, ogg123 + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This is a simple player interface - if you have an external player +;; that just expects the filename to play as an argument, this should +;; be able to use it. See the define-emms-simple-player lines at the +;; end of this file for examples. + +;; Add the following to your `emms-player-list': + +;; emms-player-mpg321 +;; emms-player-ogg123 + +;;; Code: + +;; Version control +(defvar emms-player-simple-version "0.2 $Revision: 1.26 $" + "Simple player for EMMS version string.") +;; $Id: emms-player-simple.el,v 1.26 2005/08/02 15:27:51 forcer Exp $ + +(require 'emms) + +;; Customization + +(defmacro define-emms-simple-player (name types regex command &rest args) + "Define a simple player with the use of `emms-define-player'. +NAME is used to contruct the name of the function like +emms-player-NAME. TYPES is a list of track types understood by +this player. REGEX must be a regexp that matches the filenames +the player can play. COMMAND specifies the command line argument +to call the player and ARGS are the command line arguments." + (let ((group (intern (concat "emms-player-" (symbol-name name)))) + (command-name (intern (concat "emms-player-" + (symbol-name name) + "-command-name"))) + (parameters (intern (concat "emms-player-" + (symbol-name name) + "-parameters"))) + (player-name (intern (concat "emms-player-" (symbol-name name)))) + (start (intern (concat "emms-player-" (symbol-name name) "-start"))) + (stop (intern (concat "emms-player-" (symbol-name name) "-stop"))) + (playablep (intern (concat "emms-player-" (symbol-name name) "-playable-p")))) + `(progn + (defgroup ,group nil + ,(concat "EMMS player for " command ".") + :group 'emms-player + :prefix ,(concat "emms-player-" (symbol-name name) "-")) + (defcustom ,command-name ,command + ,(concat "The command name of " command ".") + :type 'string) + (defcustom ,parameters ',args + ,(concat "The arguments to `" (symbol-name command-name) "'.") + :type '(repeat string)) + (defcustom ,player-name (emms-player #',start #',stop #',playablep) + ,(concat "A player for EMMS.") + :type '(cons symbol alist)) + (emms-player-set ,player-name 'regex ,regex) + (emms-player-set ,player-name 'pause 'emms-player-simple-pause) + (emms-player-set ,player-name 'resume 'emms-player-simple-resume) + (defun ,start (track) + "Start the player process." + (emms-player-simple-start (emms-track-name track) + ,player-name + ,command-name + ,parameters)) + (defun ,stop () + "Stop the player process." + (emms-player-simple-stop)) + (defun ,playablep (track) + "Return non-nil when we can play this track." + (and (executable-find ,command-name) + (memq (emms-track-type track) ,types) + (string-match (emms-player-get ,player-name 'regex) + (emms-track-name track))))))) + +;; Global variables +(defvar emms-player-simple-process-name "emms-player-simple-process" + "The name of the simple player process") + +(defun emms-player-simple-stop () + "Stop the currently playing process, if indeed there is one" + (let ((process (get-process emms-player-simple-process-name))) + (when process + (kill-process process) + (delete-process process)))) + +;; Utility-functions +(defun emms-player-simple-start (filename player cmdname params) + "Starts a process playing FILENAME using the specified CMDNAME with +the specified PARAMS. +PLAYER is the name of the current player." + (let ((process (apply #'start-process + emms-player-simple-process-name + nil + cmdname + ;; splice in params here + (append params (list filename))))) + ;; add a sentinel for signaling termination + (set-process-sentinel process #'emms-player-simple-sentinel)) + (emms-player-started player)) + +(defun emms-player-simple-sentinel (proc str) + "Sentinel for determining the end of process" + (ignore str) + (when (or (eq (process-status proc) 'exit) + (eq (process-status proc) 'signal)) + (emms-player-stopped))) + +(defun emms-player-simple-pause () + "Pause the player by sending a SIGSTOP." + (signal-process (get-process emms-player-simple-process-name) + 'SIGSTOP)) + +(defun emms-player-simple-resume () + "Resume the player by sending a SIGCONT." + (signal-process (get-process emms-player-simple-process-name) + 'SIGCONT)) + +(defun emms-player-simple-regexp (&rest extensions) + "Return a regexp matching all EXTENSIONS, case-insensitively." + (concat "\\.\\(" + (mapconcat (lambda (extension) + (mapconcat (lambda (char) + (let ((u (upcase char)) + (d (downcase char))) + (if (= u d) + (format "%c" char) + (format "[%c%c]" u d)))) + extension + "")) + extensions + "\\|") + "\\)\\'")) + +(define-emms-simple-player mpg321 '(file url) + (emms-player-simple-regexp "mp3" "mp2") + "mpg321") +(define-emms-simple-player ogg123 '(file) + (emms-player-simple-regexp "ogg" "flac") + "ogg123") +(define-emms-simple-player speexdec '(file) + (emms-player-simple-regexp "spx") + "speexdec") +(define-emms-simple-player playsound '(file) + (emms-player-simple-regexp "wav") + "playsound") +(define-emms-simple-player mikmod '(file) + (emms-player-simple-regexp "669" "amf" "dsm" "far" "gdm" "it" + "imf" "mod" "med" "mtm" "okt" "s3m" + "stm" "stx" "ult" "apun" "xm" "mod") + "mikmod" "-q" "-p" "1" "-X") +(define-emms-simple-player timidity '(file) + (emms-player-simple-regexp "mid" "rmi" "rcp" "r36" "g18" "g36" "mfi") + "timidity") +(define-emms-simple-player fluidsynth '(file) + (emms-player-simple-regexp "mid") + "fluidsynth" "-aalsa" "-in" "/media/music/sf/FluidR3-GM.SF2") +(define-emms-simple-player alsaplayer '(file url) + (concat "\\`http[s]?://\\|" + (emms-player-simple-regexp "ogg" "mp3" "wav" "flac" "pls" "m3u")) + "alsaplayer" "--quiet" "--nosave" "\"--interface text\"") + +(emms-player-set emms-player-alsaplayer + 'pause + 'emms-player-alsaplayer-pause) + +;;; Pause is also resume for alsaplayer +(emms-player-set emms-player-alsaplayer + 'resume + nil) + +(emms-player-set emms-player-alsaplayer + 'seek + 'emms-player-alsaplayer-seek) + +(defun emms-player-alsaplayer-pause () + (call-process "alsaplayer" nil nil nil "--pause")) + +(defun emms-player-alsaplayer-seek (sec) + (call-process "alsaplayer" nil nil nil "--relative" (format "%d" sec))) + +(provide 'emms-player-simple) +;;; emms-player-simple.el ends here diff --git a/elisp/emms-player-vlc.el b/elisp/emms-player-vlc.el new file mode 100644 index 0000000..060f0d8 --- /dev/null +++ b/elisp/emms-player-vlc.el @@ -0,0 +1,86 @@ +;;; emms-player-vlc.el --- vlc support for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Authors: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Code: + +(require 'emms-compat) +(require 'emms-player-simple) + +;; I use this macro, and later override some of the stuff it defines +;; in order to accomodate VLC's particular idioms. +(define-emms-simple-player vlc '(file url) + (concat "\\`\\(http[s]?\\|mms\\)://\\|" + (apply #'emms-player-simple-regexp + emms-player-base-format-list)) + "vlc" "--intf=rc") + +(define-emms-simple-player vlc-playlist '(streamlist) + "\\`http[s]?://" + "vlc" "--intf=rc") + +;; (kludge) By default, VLC does not quit after finishing to play a +;; track, so the player sentinel has no way of telling that the next +;; track should be played. Therefore I redefine this low-level +;; function and add a "quit" track which is invisible to Emms. +(advice-add 'emms-player-vlc-start :override #'emms--vlc-quit-after-finish) +(defun emms--vlc-quit-after-finish (track &rest _) + (let ((process (apply #'start-process + emms-player-simple-process-name + nil + emms-player-vlc-command-name + ;; splice in params here + (append emms-player-vlc-parameters + (list (emms-track-name track)) + '("vlc://quit"))))) + ;; Add a sentinel for signaling termination. + (set-process-sentinel process #'emms-player-simple-sentinel)) + (emms-player-started emms-player-vlc)) + +(defun emms-player-vlc-pause () + "Depends on vlc's rc mode." + (process-send-string + emms-player-simple-process-name "pause\n")) + +(defun emms-player-vlc-seek (sec) + "Seek relative within a stream." + (when (not (= 0 sec)) + (process-send-string + emms-player-simple-process-name + (if (< 0 sec) "fastforward\n" "rewind\n")))) + +(defun emms-player-vlc-seek-to (sec) + "Seek to time SEC within the stream." + (process-send-string + emms-player-simple-process-name + (format "seek %d\n" sec))) + +(emms-player-set emms-player-vlc 'pause 'emms-player-vlc-pause) +(emms-player-set emms-player-vlc 'resume nil) ; pause is also resume +(emms-player-set emms-player-vlc 'start 'emms-player-vlc-start) +(emms-player-set emms-player-vlc 'seek 'emms-player-vlc-seek) +(emms-player-set emms-player-vlc 'seek-to 'emms-player-vlc-seek-to) + +(provide 'emms-player-vlc) + +;;; emms-player-vlc.el ends here diff --git a/elisp/emms-player-xine.el b/elisp/emms-player-xine.el new file mode 100644 index 0000000..98c3c28 --- /dev/null +++ b/elisp/emms-player-xine.el @@ -0,0 +1,92 @@ +;;; emms-player-xine.el --- xine support for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Tassilo Horn + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This provides a player that uses xine. It supports pause and +;; seeking. + +;;; Code: + +;; TODO: The video window cannot be disabled. I asked on +;; gmane.comp.video.xine.user (<87y7ohqcbq.fsf@baldur.tsdh.de>)... + +;; TODO: Implement seek-to with "SetPositionX%\n" where X is in {0,10,..,90} + +(require 'emms-player-simple) + +(define-emms-simple-player xine '(file url) + (concat "\\`\\(http[s]?\\|mms\\)://\\|" + (emms-player-simple-regexp + "ogg" "mp3" "wav" "mpg" "mpeg" "wmv" "wma" + "mov" "avi" "divx" "ogm" "ogv" "asf" "mkv" + "rm" "rmvb" "mp4" "flac" "vob")) + "xine" "--no-gui" "--no-logo" "--no-splash" "--no-reload" "--stdctl") + +(emms-player-set emms-player-xine + 'pause + 'emms-player-xine-pause) + +;;; Pause is also resume for xine +(emms-player-set emms-player-xine + 'resume + nil) + +(emms-player-set emms-player-xine + 'seek + 'emms-player-xine-seek) + +(defun emms-player-xine-pause () + "Depends on xine's --stdctl mode." + (process-send-string + emms-player-simple-process-name "pause\n")) + +(defun emms-player-xine-seek (secs) + "Depends on xine's --stdctl mode." + ;; xine-ui's stdctl supports only seeking forward/backward in 7/15/30 and 60 + ;; second steps, so we take the value that is nearest to SECS. + (let ((s (emms-nearest-value secs '(-60 -30 -15 -7 7 15 30 60)))) + (when (/= s secs) + (message (concat "EMMS: Xine only supports seeking for [+/-] 7/15/30/60 " + "seconds, so we seeked %d seconds") s)) + (process-send-string + emms-player-simple-process-name + (if (< s 0) + (format "SeekRelative%d\n" s) + (format "SeekRelative+%d\n" s))))) + +(defun emms-nearest-value (val list) + "Returns the value of LIST which is nearest to VAL. + +LIST should be a list of integers." + (let* ((nearest (car list)) + (dist (abs (- val nearest)))) + (dolist (lval (cdr list)) + (let ((ndist (abs (- val lval)))) + (when (< ndist dist) + (setq nearest lval + dist ndist)))) + nearest)) + + +(provide 'emms-player-xine) +;;; emms-player-xine.el ends here diff --git a/elisp/emms-playing-time.el b/elisp/emms-playing-time.el new file mode 100644 index 0000000..c52d13a --- /dev/null +++ b/elisp/emms-playing-time.el @@ -0,0 +1,251 @@ +;;; emms-playing-time.el --- Display emms playing time on mode line -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: William Xu , Yoni Rabkin (yrk@gnu.org) + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Display playing time on mode line, it looks like: 01:32/04:09. + +;; Put this file into your load-path and the following into your +;; ~/.emacs: +;; (require 'emms-playing-time) +;; (emms-playing-time 1) + +;; Note: `(emms-playing-time -1)' will disable emms-playing-time module +;; completely, and is not recommended. (since some other emms modules +;; may rely on it, such as `emms-lastfm.el') + +;; Instead, to toggle displaying playing time on mode line, one could +;; call `emms-playing-time-enable-display' and +;; `emms-playing-time-disable-display'." + +;;; Code: + +(require 'cl-lib) +(require 'emms-info) +(require 'emms-player-simple) + +;;; Customizations + +(defgroup emms-playing-time nil + "Playing-time module for EMMS." + :group 'emms) + +(defcustom emms-playing-time-display-short-p nil + "Non-nil will only display elapsed time. +e.g., display 02:37 instead of 02:37/05:49." + :type 'boolean) + +(defcustom emms-playing-time-display-format " %s " + "Format used for displaying playing time." + :type 'string) + +(defcustom emms-playing-time-style 'time + "Style used for displaying playing time. +Valid styles are `time' (e.g., 01:30/4:20), + `bar' (e.g., [===> ]), +and `downtime' (e.g. -03:58)." + :type 'symbol) + + +;;; Emms Playing Time + +(define-obsolete-variable-alias 'emms-playing-time-display-p + 'emms-playing-time-display-mode "Apr 2021") +(defvar emms-playing-time-display-mode) + +(defvar emms-playing-time 0 + "Time elapsed in current track.") + +(defvar emms-playing-time-string "") + +(defvar emms-playing-time-display-timer nil) + +(define-obsolete-variable-alias 'emms-playing-time-p + 'emms-playing-time-mode "Apr 2021") + +(defun emms-playing-time-start () + "Get ready for display playing time." + (setq emms-playing-time 0) + (unless emms-playing-time-display-timer + (setq emms-playing-time-display-timer + (run-at-time t 1 #'emms-playing-time-display)))) + +(defun emms-playing-time-stop () + "Remove playing time on the mode line." + (if (or (not emms-player-paused-p) + emms-player-stopped-p) + (progn + (setq emms-playing-time-string "") + (force-mode-line-update))) + (emms-cancel-timer emms-playing-time-display-timer) + (setq emms-playing-time-display-timer nil)) + +(defun emms-playing-time-pause () + "Pause playing time." + (if emms-player-paused-p + (emms-playing-time-stop) + (unless emms-playing-time-display-timer + (setq emms-playing-time-display-timer + (run-at-time t 1 #'emms-playing-time-display))))) + +(defun emms-playing-time-seek (sec) + "Seek forward or backward SEC playing time." + (setq emms-playing-time (+ emms-playing-time sec)) + (when (< emms-playing-time 0) ; back to start point + (setq emms-playing-time 0))) + +(defun emms-playing-time-set (sec) + "Set the playing time to SEC." + (setq emms-playing-time sec) + (when (< emms-playing-time 0) ; back to start point + (setq emms-playing-time 0))) + +(defun emms-playing-time (arg) + (declare (obsolete emms-playing-time-mode "Apr 2021")) + (emms-playing-time-mode (if (and arg (> arg 0)) 1 -1))) + + +(define-minor-mode emms-playing-time-mode + "Turn on emms playing time if ARG is positive, off otherwise. + +Note: `(emms-playing-time -1)' will disable emms-playing-time +module completely, and is not recommended. (since some other emms +modules may rely on it, such as `emms-lastfm.el') + +Instead, to toggle displaying playing time on mode line, one +could call `emms-playing-time-enable-display' and +`emms-playing-time-disable-display'." + :global t + (if emms-playing-time-mode + (progn + ;; FIXME: Maybe we shouldn't set this here, and instead the users + ;; should call `emms-playing-time-display-mode' if that's what + ;; they want. + (setq emms-playing-time-display-mode t) + (emms-playing-time-mode-line) + (add-hook 'emms-player-started-hook #'emms-playing-time-start) + (add-hook 'emms-player-stopped-hook #'emms-playing-time-stop) + (add-hook 'emms-player-finished-hook #'emms-playing-time-stop) + (add-hook 'emms-player-paused-hook #'emms-playing-time-pause) + (add-hook 'emms-player-seeked-functions #'emms-playing-time-seek) + (add-hook 'emms-player-time-set-functions #'emms-playing-time-set)) + (setq emms-playing-time-display-mode nil) + (emms-playing-time-stop) + (emms-playing-time-restore-mode-line) + (remove-hook 'emms-player-started-hook #'emms-playing-time-start) + (remove-hook 'emms-player-stopped-hook #'emms-playing-time-stop) + (remove-hook 'emms-player-finished-hook #'emms-playing-time-stop) + (remove-hook 'emms-player-paused-hook #'emms-playing-time-pause) + (remove-hook 'emms-player-seeked-functions #'emms-playing-time-seek) + (remove-hook 'emms-player-time-set-functions #'emms-playing-time-set))) + +;;;###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. + (if emms-playing-time-display-mode + (emms-playing-time-display-mode 1))) + +;;;###autoload +(defun emms-playing-time-enable-display () + "Display playing time on mode line." + (declare (obsolete emms-playing-time-display-mode "Apr 2021")) + (interactive) + (setq emms-playing-time-display-mode t)) + +;;;###autoload +(defun emms-playing-time-disable-display () + "Remove playing time from mode line." + (declare (obsolete emms-playing-time-display-mode "Apr 2021")) + (interactive) + (setq emms-playing-time-display-mode nil)) + +(defun emms-playing-time-display () + "Display playing time on the mode line." + (setq emms-playing-time (round (1+ emms-playing-time))) + (setq emms-playing-time-string + (if (null emms-playing-time-display-mode) + "" + (let* ((min (/ emms-playing-time 60)) + (sec (% emms-playing-time 60)) + (total-playing-time + (or (emms-track-get + (emms-playlist-current-selected-track) + 'info-playing-time) + 0)) + (total-min-only (/ total-playing-time 60)) + (total-sec-only (% total-playing-time 60)) + (string + (cl-case emms-playing-time-style + ((downtime) ; `downtime' style + (emms-replace-regexp-in-string + " " "0" + (if (or emms-playing-time-display-short-p + ;; unable to get total playing-time + (eq total-playing-time 0)) + (format "%2d:%2d" min sec) + (format "-%2d:%2d" + (/ (- total-playing-time emms-playing-time) 60) + (% (- total-playing-time sec) 60))))) + ((bar) ; `bar' style + (if (zerop total-playing-time) + "[==>........]" + (let (;; percent based on 10 + (percent (/ (* emms-playing-time 10) + total-playing-time))) + (concat "[" + (make-string percent ?=) + ">" + (make-string (- 10 percent) ?\s) + "]")))) + (t ; `time' style + (emms-replace-regexp-in-string + " " "0" + (if (or emms-playing-time-display-short-p + ;; unable to get total playing-time + (eq total-playing-time 0)) + (format "%2d:%2d" min sec) + (format "%2d:%2d/%2s:%2s" + min sec total-min-only total-sec-only))))))) + (format emms-playing-time-display-format string)))) + (force-mode-line-update)) + +(defun emms-playing-time-mode-line () + "Add playing time to the mode line." + (or global-mode-string (setq global-mode-string '(""))) + (unless (member 'emms-playing-time-string + global-mode-string) + (setq global-mode-string + (append global-mode-string + '(emms-playing-time-string))))) + +(defun emms-playing-time-restore-mode-line () + "Restore the mode line." + (setq global-mode-string + (remove 'emms-playing-time-string global-mode-string)) + (force-mode-line-update)) + +(provide 'emms-playing-time) + +;;; emms-playing-time.el ends here diff --git a/elisp/emms-playlist-limit.el b/elisp/emms-playlist-limit.el new file mode 100644 index 0000000..df28374 --- /dev/null +++ b/elisp/emms-playlist-limit.el @@ -0,0 +1,223 @@ +;;; emms-playlist-limit.el --- Limit playlist by various info -*- lexical-binding: t -*- + +;; Copyright (C) 2018-2021 Free Software Foundation, Inc. + +;; Author: William Xu +;; Author: Fran Burstall +;; Keywords: emms, limit + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This code allows you to "limit" a playlist in the current buffer +;; by creating, and switching to, a derived playlist containing only +;; those tracks with a type (info-artist and the like) matching a +;; regexp. + +;; If the current buffer is the current playlist then the derived +;; playlist is made current. + +;; Usage: +;; ------------------------------------------------------------------ + +;; This code is activated by (emms-all). Otherwise simply do: + +;; (require 'emms-playlist-limit) + +;; Key bindings +;; ------------------------------------------------------------------ + +;; / / emms-playlist-limit-to-all +;; / a emms-playlist-limit-to-info-artist +;; / b emms-playlist-limit-to-info-album +;; / c emms-playlist-limit-to-info-composer +;; / d emms-playlist-limit-to-description +;; / g emms-playlist-limit-to-info-genre +;; / n emms-playlist-limit-to-name +;; / p emms-playlist-limit-to-info-performer +;; / t emms-playlist-limit-to-info-title +;; / y emms-playlist-limit-to-info-year + +;;; Code: + +(require 'seq) +(require 'emms-playlist-mode) + +;; User Interfaces + +(defgroup emms-playlist-limit nil + "Playlist limit module for EMMS." + :group 'emms) + +(defcustom emms-playlist-limit-hook nil + "Hooks to run after each limit operation." + :type 'symbol) + +(defmacro define-emms-playlist-limit (attribute) + "Macro for defining emms playlist limit to ATTRIBUTE function." + `(defun ,(intern (format "emms-playlist-limit-to-%s" attribute)) (regexp) + ,(format "Switch to a playlist comprising tracks with %s matching REGEXP. + +REGEXP defaults to the value of %s for the track at point. + +When the current buffer is the current playlist, make the derived playlist +the current playlist." attribute attribute) + (interactive + (list + (let* ((curr + (or (emms-playlist-limit-track-get + (or (emms-playlist-track-at) + (emms-playlist-track-at (max 1 (1- (point))))) ; at eol + (quote ,attribute)) + (emms-playlist-limit-track-get + (emms-playlist-selected-track) (quote ,attribute)))) + (attr-name ,(emms-replace-regexp-in-string + "info-" "" (symbol-name attribute))) + (fmt (if curr + (format "Limit to %s (regexp = %s): " attr-name curr) + (format "Limit to %s (regexp): " attr-name)))) + (read-string fmt)))) + (when (string= regexp "") + (setq regexp (or (emms-playlist-limit-track-get + (or (emms-playlist-track-at) + (emms-playlist-track-at (max 1 (1- (point))))) ; at eol + (quote ,attribute)) + (emms-playlist-limit-track-get + (emms-playlist-selected-track) (quote ,attribute))))) + (if regexp + (emms-playlist-limit-do (quote ,attribute) regexp) + (message "Limit cancelled: no regexp.")))) + +(define-emms-playlist-limit info-artist) +(define-emms-playlist-limit info-composer) +(define-emms-playlist-limit info-performer) +(define-emms-playlist-limit info-title) +(define-emms-playlist-limit info-album) +(define-emms-playlist-limit info-year) +(define-emms-playlist-limit info-genre) +(define-emms-playlist-limit name) +(define-emms-playlist-limit description) + +(defvar-local emms-playlist-limit--original-playlist nil + "Playlist buffer from which we derive the limited playlist.") + +(defun emms-playlist-limit-to-all () + "Switch to playlist from which this playlist was derived (if it still exists) +and bury this playlist. + +If this playlist is current, make the playlist we switch to current." + (interactive) + (when (and emms-playlist-limit--original-playlist + (buffer-live-p emms-playlist-limit--original-playlist)) + (let* ((old-buf (current-buffer)) + (old-buf-is-current-playlist (eq old-buf emms-playlist-buffer))) + (switch-to-buffer emms-playlist-limit--original-playlist) + (when old-buf-is-current-playlist + (emms-playlist-set-playlist-buffer)) + (bury-buffer old-buf)))) + +(define-key emms-playlist-mode-map (kbd "/ n") #'emms-playlist-limit-to-name) +(define-key emms-playlist-mode-map (kbd "/ a") #'emms-playlist-limit-to-info-artist) +(define-key emms-playlist-mode-map (kbd "/ c") #'emms-playlist-limit-to-info-composer) +(define-key emms-playlist-mode-map (kbd "/ p") #'emms-playlist-limit-to-info-performer) +(define-key emms-playlist-mode-map (kbd "/ t") #'emms-playlist-limit-to-info-title) +(define-key emms-playlist-mode-map (kbd "/ b") #'emms-playlist-limit-to-info-album) +(define-key emms-playlist-mode-map (kbd "/ y") #'emms-playlist-limit-to-info-year) +(define-key emms-playlist-mode-map (kbd "/ g") #'emms-playlist-limit-to-info-genre) +(define-key emms-playlist-mode-map (kbd "/ d") #'emms-playlist-limit-to-description) +(define-key emms-playlist-mode-map (kbd "/ /") #'emms-playlist-limit-to-all) + + +;;; Low Level Functions + +(defun emms-playlist-limit-track-get (track type) + "Return the value of TYPE from TRACK. + +Here TYPE is a field available to `emms-track-get\\=' or +\\='description which gives the result of +`emms-track-description-function\\='. + +When type is \\='info-year, also tries \\='info-originalyear, + \\='info-originaldate and \\='info-date to get a usable date." + (cond ((eq type 'info-year) + (let ((date (or (emms-track-get track 'info-originaldate) + (emms-track-get track 'info-originalyear) + (emms-track-get track 'info-date) + (emms-track-get track 'info-year)))) + (or (emms-format-date-to-year date) + ""))) + ((eq type 'description) (funcall emms-track-description-function track)) + (t (emms-track-get track type)))) + +(defun emms-playlist-limit--derive-playlist (playlist pred name) + "Return a new playlist NAME of tracks in PLAYLIST for which (PRED track) +is non-nil." + (let* ((tracks (nreverse (with-current-buffer playlist + (save-excursion (emms-playlist-tracks-in-region (point-min) (point-max)))))) + (filtered-tracks (seq-filter pred tracks)) + (new-playlist (or (get-buffer name) + (emms-playlist-new name)))) + (with-current-buffer new-playlist + (emms-with-inhibit-read-only-t (erase-buffer)) + (mapc #'emms-playlist-insert-track filtered-tracks)) + new-playlist)) + +(defun emms-playlist-limit--limit-playlist (playlist type regexp) + "Return a new playlist of tracks in PLAYLIST with TYPE matching REGEXP." + (let* ((bufname (format "%s/%s=%s" + (buffer-name playlist) + (emms-replace-regexp-in-string "info-" "" + (symbol-name type)) + regexp))) + (emms-playlist-limit--derive-playlist + playlist + (lambda (track) (let ((field (emms-playlist-limit-track-get track type))) + (and field (string-match regexp field)))) + bufname))) + +(defun emms-playlist-limit-do (type regexp) + "Switch to a derived playlist containing the tracks with TYPE matching REGEXP. +e.g., + (emms-playlist-limit-do \\='info-artist \"Jane Zhang\") + +See `emms-info-mp3find-arguments\\=' for possible options for TYPE." + (emms-playlist-ensure-playlist-buffer) + (let* ((curr (emms-playlist-selected-track)) + (old-buf (current-buffer)) + (old-buf-is-current-playlist (eq old-buf emms-playlist-buffer)) + (buf (emms-playlist-limit--limit-playlist old-buf type regexp))) + (with-current-buffer buf + (if (= (point-min) (point-max)) + (progn + (message "No matching tracks found!") + (kill-buffer)) + (let ((pos (when curr (text-property-any (point-min) (point-max) + 'emms-track curr)))) + (if pos + (emms-playlist-select pos) + (emms-playlist-select-first))) + (emms-playlist-mode-center-current) + (setq emms-playlist-limit--original-playlist old-buf) + (when old-buf-is-current-playlist + (emms-playlist-set-playlist-buffer)) + (run-hooks 'emms-playlist-limit-hook) + (switch-to-buffer buf))))) + + +(provide 'emms-playlist-limit) + +;;; emms-playlist-limit.el ends here diff --git a/elisp/emms-playlist-mode.el b/elisp/emms-playlist-mode.el new file mode 100644 index 0000000..e0d3757 --- /dev/null +++ b/elisp/emms-playlist-mode.el @@ -0,0 +1,627 @@ +;;; emms-playlist-mode.el --- Playlist mode for Emms. -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2023 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;;; +;; This is a method of displaying and manipulating the different Emms +;; playlist buffers. +;; +;; Emms developer's motto: "When forcer says (require 'jump) we say +;; (funcall #'jump height)" + +;;; Code: + + +;;; -------------------------------------------------------- +;;; Variables +;;; -------------------------------------------------------- +(require 'emms) +(condition-case nil + (require 'overlay) + (error nil)) +(require 'emms-source-playlist) + +(defvar emms-playlist-mode-hook nil + "Emms playlist mode hook.") + +(defvar emms-playlist-mode-selected-overlay nil + "Last selected track. Use for updating the display.") + +(defvar emms-playlist-mode-switched-buffer nil + "Last buffer visited before calling `emms-playlist-mode-switch-buffer'.") + +(defvar emms-playlist-mode-popup-enabled nil + "True when the playlist was called as a popup window.") + +(defvar emms-playlist-mode-kill-whole-line-p t + "When true line kills behave like a typical music player.") + +(make-variable-buffer-local + 'emms-playlist-mode-selected-overlay) + +(defgroup emms-playlist-mode nil + "*The Emacs Multimedia System playlist mode." + :prefix "emms-playlist-mode-" + :group 'emms) + +(defcustom emms-playlist-mode-open-playlists nil + "Determine whether to open playlists in a new EMMS buffer on RET. +This is useful if you have a master playlist buffer that is +composed of other playlists." + :type 'boolean) + +(defcustom emms-playlist-mode-window-width 25 + "Determine the width of the Emms popup window. +The value should a positive integer." + :type 'integer) + +(defcustom emms-playlist-mode-center-when-go nil + "Determine whether to center on the currently selected track. +This is true for every invocation of `emms-playlist-mode-go'." + :type 'boolean) + + +;;; -------------------------------------------------------- +;;; Faces +;;; -------------------------------------------------------- +(defface emms-playlist-track-face + '((((class color) (background dark)) + (:foreground "DarkSeaGreen")) + (((class color) (background light)) + (:foreground "Blue")) + (((type tty) (class mono)) + (:inverse-video t)) + (t (:background "Blue"))) + "Face for the tracks in a playlist buffer.") + +(defface emms-playlist-selected-face + '((((class color) (background dark)) + (:foreground "SteelBlue3")) + (((class color) (background light)) + (:background "blue3" :foreground "white")) + (((type tty) (class mono)) + (:inverse-video t)) + (t (:background "blue3"))) + "Face for highlighting the selected track.") + + +;;; -------------------------------------------------------- +;;; Keys +;;; -------------------------------------------------------- +(defvar emms-playlist-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map (kbd "C-x C-s") #'emms-playlist-save) + (define-key map (kbd "C-y") #'emms-playlist-mode-yank) + (define-key map (kbd "C-k") #'emms-playlist-mode-kill-track) + (define-key map (kbd "C-w") #'emms-playlist-mode-kill) + (define-key map (kbd "C-_") #'emms-playlist-mode-undo) + (define-key map (kbd "C-/") #'emms-playlist-mode-undo) + (define-key map (kbd "C-x u") #'emms-playlist-mode-undo) + (define-key map (kbd "C-n") #'next-line) + (define-key map (kbd "C-p") #'previous-line) + (define-key map (kbd "C-j") #'emms-playlist-mode-insert-newline) + (define-key map (kbd "M-y") #'emms-playlist-mode-yank-pop) + (define-key map (kbd "M-<") #'emms-playlist-mode-first) + (define-key map (kbd "M->") #'emms-playlist-mode-last) + (define-key map (kbd "M-n") #'emms-playlist-mode-next) + (define-key map (kbd "M-p") #'emms-playlist-mode-previous) + (define-key map (kbd "a") #'emms-playlist-mode-add-contents) + (define-key map (kbd "b") #'emms-playlist-set-playlist-buffer) + (define-key map (kbd "D") #'emms-playlist-mode-kill-track) + (define-key map (kbd "n") #'emms-next) + (define-key map (kbd "p") #'emms-previous) + (define-key map (kbd "SPC") #'scroll-up) + (define-key map (kbd ">") #'emms-seek-forward) + (define-key map (kbd "<") #'emms-seek-backward) + (define-key map (kbd "P") #'emms-pause) + (define-key map (kbd "s") #'emms-stop) + (define-key map (kbd "f") #'emms-show) + (define-key map (kbd "c") #'emms-playlist-mode-center-current) + (define-key map (kbd "q") #'emms-playlist-mode-bury-buffer) + (define-key map (kbd "K") #'emms-playlist-mode-current-kill) + (define-key map (kbd "?") #'describe-mode) + (define-key map (kbd "r") #'emms-random) + (define-key map (kbd "C") #'emms-playlist-clear) + (define-key map (kbd "d") #'emms-playlist-mode-goto-dired-at-point) + (define-key map (kbd "") #'emms-playlist-mode-play-current-track) + (define-key map (kbd "RET") #'emms-playlist-mode-play-smart) + map) + "Keymap for `emms-playlist-mode'.") + +(defmacro emms-playlist-mode-move-wrapper (name fun) + "Create a function NAME which is an `interactive' version of FUN. + +NAME should be a symbol. +FUN should be a function." + `(defun ,name () + ,(format "Interactive wrapper around `%s' for playlist-mode." + fun) + (interactive) + (,fun))) + +(emms-playlist-mode-move-wrapper emms-playlist-mode-first + emms-playlist-first) + +(emms-playlist-mode-move-wrapper emms-playlist-mode-select-next + emms-playlist-next) + +(emms-playlist-mode-move-wrapper emms-playlist-mode-select-previous + emms-playlist-previous) + +(defun emms-playlist-mode-bury-buffer () + "Wrapper around `bury-buffer' for popup windows." + (interactive) + (if emms-playlist-mode-popup-enabled + (unwind-protect + (delete-window) + (setq emms-playlist-mode-popup-enabled nil)) + (bury-buffer))) + +(defun emms-playlist-mode-current-kill () + "If the current buffer is an EMMS playlist buffer, kill it. +Otherwise, kill the current EMMS playlist buffer." + (interactive) + (if (and emms-playlist-buffer-p + (not (eq (current-buffer) emms-playlist-buffer))) + (kill-buffer (current-buffer)) + (emms-playlist-current-kill))) + +(defun emms-playlist-mode-last () + "Move to directly after the last track in the current buffer." + (interactive) + (emms-playlist-ensure-playlist-buffer) + (let ((last (condition-case nil + (save-excursion + (goto-char (point-max)) + (point)) + (error + nil)))) + (if last + (goto-char last) + (error "No last track")))) + +(defun emms-playlist-mode-center-current () + "Move point to the currently selected track." + (interactive) + (goto-char (if emms-playlist-mode-selected-overlay + (overlay-start emms-playlist-mode-selected-overlay) + (point-min)))) + +(defun emms-playlist-mode-play-current-track () + "Start playing track at point." + (interactive) + (emms-playlist-set-playlist-buffer (current-buffer)) + (unless (emms-playlist-track-at (point)) + (emms-playlist-next)) + (emms-playlist-select (point)) + (when emms-player-playing-p + (emms-stop)) + (emms-start)) + +(defun emms-playlist-mode-play-smart () + "Determine the best operation to take on the current track. + +If on a playlist, and `emms-playlist-mode-open-playlists' is +non-nil, load the playlist at point into a new buffer. + +Otherwise play the track immediately." + (interactive) + (save-excursion + ;; move to the start of the line, in case the point is on the \n, + ;; which isn't propertized + (emms-move-beginning-of-line nil) + (if (not emms-playlist-mode-open-playlists) + (emms-playlist-mode-play-current-track) + (unless (emms-playlist-track-at) + (emms-playlist-next)) + (let* ((track (emms-playlist-track-at)) + (name (emms-track-get track 'name)) + (type (emms-track-get track 'type))) + (if (or (eq type 'playlist) + (and (eq type 'file) + (string-match "\\.\\(m3u\\|pls\\)\\'" name))) + (emms-playlist-mode-load-playlist) + (emms-playlist-mode-play-current-track)))))) + +(defun emms-playlist-mode-switch-buffer () + "Switch to the playlist buffer and then switch back if called again. + +This function switches to the current Emms playlist buffer and +remembers the buffer switched from. When called again the +function switches back to the remembered buffer." + (interactive) + (if (eq (current-buffer) + emms-playlist-buffer) + (switch-to-buffer emms-playlist-mode-switched-buffer) + (setq emms-playlist-mode-switched-buffer (current-buffer)) + (switch-to-buffer emms-playlist-buffer))) + +(defun emms-playlist-mode-insert-newline () + "Insert a newline at point." + (interactive) + (emms-with-inhibit-read-only-t + (newline))) + +(defun emms-playlist-mode-undo () + "Wrapper around `undo'." + (interactive) + (emms-with-inhibit-read-only-t + (undo))) + +(defun emms-playlist-mode-add-after-current (dir) + "Insert tracks from directory tree DIR after current track." + (interactive (list + (emms-read-directory-name "Add directory after current track: " + (emms-source-file-directory-hint) + emms-source-file-default-directory + t))) + (let ((p (if emms-playlist-mode-selected-overlay + (overlay-start emms-playlist-mode-selected-overlay) + (error "no current track")))) + (goto-char p) + (forward-line 1) + (emms-insert-directory-tree dir))) + +(defun emms-playlist-mode-add-contents () + "Add files in the playlist at point to the current playlist buffer. + +If we are in the current playlist, make a new playlist buffer and +set it as current." + (interactive) + (save-excursion + (emms-move-beginning-of-line nil) + (unless (emms-playlist-track-at) + (emms-playlist-next)) + (let* ((track (emms-playlist-track-at)) + (name (emms-track-get track 'name)) + (type (emms-track-get track 'type)) + (playlist-p (or (eq type 'playlist) + (and (eq type 'file) + (save-match-data + (string-match "\\.\\(m3u\\|pls\\)\\'" + name)))))) + (emms-playlist-select (point)) + (unless (and (buffer-live-p emms-playlist-buffer) + (not (eq (current-buffer) emms-playlist-buffer))) + (setq emms-playlist-buffer + (emms-playlist-set-playlist-buffer (emms-playlist-new)))) + (with-current-emms-playlist + (goto-char (point-max)) + (when playlist-p + (insert (emms-track-force-description track) "\n")) + (let ((beg (point))) + (if playlist-p + (emms-add-playlist name) + (let ((func (intern (concat "emms-add-" (symbol-name type))))) + (if (functionp func) + (funcall func name) + ;; fallback + (emms-add-file name)))) + (when playlist-p + (goto-char (point-max)) + (while (progn + (forward-line -1) + (>= (point) beg)) + (insert " "))) + (goto-char (point-min)) + (message "Added %s" (symbol-name type))))))) + +(defun emms-playlist-mode-goto-dired-at-point (&optional other-window) + "Visit the track at point in a `dired' buffer. + +With a prefix arg, open the `dired' buffer in OTHER-WINDOW." + (interactive "P") + (let ((track (emms-playlist-track-at))) + (if track + (let ((name (emms-track-get track 'name)) + (type (emms-track-get track 'type))) + (if (eq type 'file) + (dired-jump other-window name) + (error "Can't visit this track type in Dired"))) + (error "No track at point")))) + + +;;; -------------------------------------------------------- +;;; Killing and yanking +;;; -------------------------------------------------------- +(defun emms-playlist-mode-between-p (p a b) + "Return t if P is a point between points A and B." + (and (<= a p) + (<= p b))) + +;; D +(defun emms-playlist-mode-kill-entire-track () + "Kill track at point, including newline." + (interactive) + (let ((kill-whole-line t)) + (emms-playlist-mode-kill-track))) + +;; C-k +(defun emms-playlist-mode-kill-track () + "Kill track at point." + (interactive) + (emms-with-inhibit-read-only-t + (let ((track (emms-playlist-track-at))) + (when track + (let ((track-region (emms-property-region (point) + 'emms-track))) + (ignore track-region) + (when (and emms-player-playing-p + (emms-playlist-selected-track-at-p)) + (emms-stop) + (delete-overlay emms-playlist-mode-selected-overlay) + (setq emms-playlist-mode-selected-overlay nil)))) + (let ((kill-whole-line emms-playlist-mode-kill-whole-line-p)) + (goto-char (line-beginning-position)) + (kill-line))))) + +;; C-w +(defun emms-playlist-mode-kill () + "Kill from mark to point." + (interactive) + (emms-with-inhibit-read-only-t + ;; Are we killing the playing/selected track? + (when (and (markerp emms-playlist-selected-marker) + (emms-playlist-mode-between-p + (marker-position emms-playlist-selected-marker) + (region-beginning) + (region-end))) + (emms-stop) + (delete-overlay emms-playlist-mode-selected-overlay) + (setq emms-playlist-mode-selected-overlay nil)) + (kill-region (region-beginning) + (region-end)))) + +(defun emms-playlist-mode-correct-previous-yank () + "Fix the previous yank if needed." + (when (and (< (line-beginning-position) (point)) + (< (point) (line-end-position))) + (newline))) + +;; C-y +(defun emms-playlist-mode-yank () + "Yank into the playlist buffer." + (interactive) + (emms-with-inhibit-read-only-t + (goto-char (line-beginning-position)) + (yank) + (emms-playlist-mode-correct-previous-yank))) + +;; M-y +(defun emms-playlist-mode-yank-pop () + "Cycle through the kill-ring." + (interactive) + (emms-with-inhibit-read-only-t + (yank-pop nil) + (emms-playlist-mode-correct-previous-yank))) + + +;;; -------------------------------------------------------- +;;; Overlay +;;; -------------------------------------------------------- +(defun emms-playlist-mode-overlay-selected () + "Place an overlay over the currently selected track." + (when emms-playlist-selected-marker + (save-excursion + (goto-char emms-playlist-selected-marker) + (let ((reg (emms-property-region (point) 'emms-track))) + (if emms-playlist-mode-selected-overlay + (move-overlay emms-playlist-mode-selected-overlay + (car reg) + (cdr reg)) + (setq emms-playlist-mode-selected-overlay + (make-overlay (car reg) + (cdr reg) + nil t nil)) + (overlay-put emms-playlist-mode-selected-overlay + 'face 'emms-playlist-selected-face) + (overlay-put emms-playlist-mode-selected-overlay + 'evaporate t)))))) + + +;;; -------------------------------------------------------- +;;; Saving/Restoring +;;; -------------------------------------------------------- +(defun emms-playlist-mode-open-buffer (filename) + "Opens a previously saved playlist buffer. + +It creates a buffer called \"filename\", and restores the contents +of the saved playlist inside." + (interactive "fFile: ") + (let* ((s) + (buffer (get-buffer-create filename)) + (name (buffer-name buffer))) + (with-current-buffer buffer + (emms-insert-file-contents filename) + (setq s (read (buffer-string)))) + (kill-buffer buffer) + (with-current-buffer (emms-playlist-new name) + (emms-with-inhibit-read-only-t + (insert s) + (goto-char (point-min)) + (emms-walk-tracks + (emms-playlist-update-track))) + (emms-playlist-first) + (emms-playlist-select (point)) + (switch-to-buffer (current-buffer))))) + +(defun emms-playlist-mode-load-playlist () + "Load the playlist into a new EMMS buffer. +This preserves the current EMMS buffer." + (interactive) + (let* ((track (emms-playlist-track-at)) + (name (emms-track-get track 'name))) + (emms-playlist-select (point)) + (run-hooks 'emms-player-stopped-hook) + (switch-to-buffer + (emms-playlist-set-playlist-buffer (emms-playlist-new))) + (emms-add-playlist name))) + + +;;; -------------------------------------------------------- +;;; Local functions +;;; -------------------------------------------------------- +(defun emms-playlist-mode-insert-track (track &optional no-newline) + "Insert the description of TRACK at point. +When NO-NEWLINE is non-nil, do not insert a newline after the track." + (emms-playlist-ensure-playlist-buffer) + (emms-with-inhibit-read-only-t + (insert (emms-propertize (emms-track-force-description track) + 'emms-track track + 'face 'emms-playlist-track-face)) + (when (emms-playlist-selected-track-at-p) + (emms-playlist-mode-overlay-selected)) + (unless no-newline + (insert "\n")))) + +(defun emms-playlist-mode-update-track-function () + "Update the track display at point." + (emms-playlist-ensure-playlist-buffer) + (emms-with-inhibit-read-only-t + (let ((track-region (emms-property-region (point) + 'emms-track)) + (track (get-text-property (point) + 'emms-track)) + (selectedp (emms-playlist-selected-track-at-p))) + (save-excursion + (delete-region (car track-region) + (cdr track-region)) + (when selectedp + (delete-overlay emms-playlist-mode-selected-overlay) + (setq emms-playlist-mode-selected-overlay nil)) + (emms-playlist-mode-insert-track track t)) + (when selectedp + (emms-playlist-select (point)))))) + + +;;; -------------------------------------------------------- +;;; Entry +;;; -------------------------------------------------------- +(defun emms-playlist-mode-go () + "Switch to the current emms-playlist buffer and use emms-playlist-mode." + (interactive) + (if (or (null emms-playlist-buffer) + (not (buffer-live-p emms-playlist-buffer))) + (error "No current Emms buffer") + (switch-to-buffer emms-playlist-buffer) + (when (and (not (member major-mode '(emms-playlist-mode emms-mark-mode))) + emms-playlist-buffer-p) + (emms-playlist-mode)) + (when emms-playlist-mode-center-when-go + (emms-playlist-mode-center-current)))) + +(defun emms () + "Switch to the current emms-playlist buffer, use +emms-playlist-mode and query for a directory tree to add to the +playlist." + (interactive) + (if (or (null emms-playlist-buffer) + (not (buffer-live-p emms-playlist-buffer))) + (call-interactively 'emms-add-directory)) + (emms-playlist-mode-go)) + +(defun emms-playlist-mode-go-popup (&optional window-width) + "Popup emms-playlist buffer as a side window. + +Default value for WINDOW-WIDTH is `emms-playlist-mode-window-width'. +WINDOW-WIDTH should be a positive integer." + (interactive) + (setq emms-playlist-mode-window-width + (round (or window-width emms-playlist-mode-window-width))) + (split-window-horizontally (- emms-playlist-mode-window-width)) + (other-window 1) + (emms-playlist-mode-go) + (setq emms-playlist-mode-popup-enabled t)) + +(defun emms-playlist-mode-next (arg) + "Navigate between playlists." + (interactive "p") + (let ((playlists (emms-playlist-buffer-list)) + bufs idx) + (if playlists + ;; if not in playlist mode, switch to emms-playlist-buffer + (if (not (member (current-buffer) playlists)) + (switch-to-buffer (if (and emms-playlist-buffer + (buffer-live-p emms-playlist-buffer)) + emms-playlist-buffer + (car playlists))) + (setq bufs (member (current-buffer) playlists)) + (setq idx + (+ (- (length playlists) (length bufs)) + (if (> arg 0) 1 -1))) + (switch-to-buffer (nth (mod idx (length playlists)) playlists))) + (message "No playlist found!")))) +(defun emms-playlist-mode-previous (arg) + (interactive "p") + (emms-playlist-mode-next (- arg))) + +(defun emms-playlist-mode-startup () + "Instigate emms-playlist-mode on the current buffer." + ;; when there is neither a current emms track or a playing one... + (when (not (or emms-playlist-selected-marker + emms-player-playing-p)) + ;; ...then stop the player. + (emms-stop) + ;; why select the first track? + (when emms-playlist-buffer-p + (emms-playlist-select-first))) + ;; when there is a selected track. + (when emms-playlist-selected-marker + (emms-playlist-mode-overlay-selected)) + (emms-with-inhibit-read-only-t + (add-text-properties (point-min) + (point-max) + '(face emms-playlist-track-face))) + (setq buffer-read-only t) + (setq truncate-lines t) + (setq buffer-undo-list nil)) + +;;;###autoload +(defun emms-playlist-mode () ;FIXME: Use `define-derived-mode'. + "A major mode for Emms playlists. +\\{emms-playlist-mode-map}" + (interactive) + (let ((val emms-playlist-buffer-p)) + (kill-all-local-variables) + (setq emms-playlist-buffer-p val)) + + (use-local-map emms-playlist-mode-map) + (setq major-mode 'emms-playlist-mode + mode-name "EMMS") + + (setq emms-playlist-insert-track-function + #'emms-playlist-mode-insert-track) + (setq emms-playlist-update-track-function + #'emms-playlist-mode-update-track-function) + (add-hook 'emms-playlist-selection-changed-hook + #'emms-playlist-mode-overlay-selected) + + (emms-playlist-mode-startup) + + (run-hooks 'emms-playlist-mode-hook)) + + +(provide 'emms-playlist-mode) + + +;;; emms-playlist-mode.el ends here diff --git a/elisp/emms-playlist-sort.el b/elisp/emms-playlist-sort.el new file mode 100644 index 0000000..17f342c --- /dev/null +++ b/elisp/emms-playlist-sort.el @@ -0,0 +1,226 @@ +;;; emms-playlist-sort.el --- sort emms playlist -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2021 Free Software Foundation, Inc. + +;; Author: William Xu + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Code: + +(require 'cl-lib) +(require 'emms-last-played) +(require 'emms-playlist-mode) + +;;; User Customizations + +(defgroup emms-playlist-sort nil + "Sorting Emacs Multimedia System playlists." + :prefix "emms-playlist-sort-" + :group 'emms) + +(defcustom emms-playlist-sort-list '(info-artist info-album) + "Sorting list used by `emms-playlist-sort-by-list'. +Currently it understands the following fields: name info-artist +imfo-composer info-performer info-title info-album info-genre +info-playing-time info-tracknumber info-discnumber." + :type 'symbol) + +(defcustom emms-playlist-sort-prefix "S" + "Prefix key sequence for `emms-playlist-sort-map'. +Remember to call `emms-playlist-sort-map-setup' if you modify it." + :type 'string) + + +;;; User Interfaces + +(defmacro define-emms-playlist-sort (attribute) + "Macro for defining emms playlist sort functions on strings ." + `(defun ,(intern (format "emms-playlist-sort-by-%s" attribute)) () + ,(format "Sort emms playlist by %s, increasingly. +With a prefix argument, decreasingly." attribute) + (interactive) + (emms-playlist-sort + '(lambda (a b) + (funcall + (if current-prefix-arg 'emms-string> 'emms-string<) + (emms-track-get a (quote ,attribute)) + (emms-track-get b (quote ,attribute))))))) + +(define-emms-playlist-sort name) +(define-emms-playlist-sort info-artist) +(define-emms-playlist-sort info-composer) +(define-emms-playlist-sort info-performer) +(define-emms-playlist-sort info-title) +(define-emms-playlist-sort info-album) +(define-emms-playlist-sort info-year) +(define-emms-playlist-sort info-note) + +(defun emms-playlist-sort-by-natural-order () + "Sort emms playlist by natural order. +See `emms-sort-natural-order-less-p'." + (interactive) + (emms-playlist-sort 'emms-sort-natural-order-less-p)) + +(defun emms-playlist-sort-by-list () + "Sort emms playlist by `emms-playlist-sort-list'. +The sort will be carried out until comparsion succeeds, increasingly." + (interactive) + (emms-playlist-sort 'emms-playlist-sort-by-list-p)) + +(defun emms-playlist-sort-by-last-played () + "Sort emms playlist by last played time, increasingly. +With a prefix argument, decreasingly." + (interactive) + (emms-playlist-sort + '(lambda (a b) + (funcall + (if current-prefix-arg 'not 'identity) + (time-less-p + (or (emms-track-get a 'last-played) '(0 0 0)) + (or (emms-track-get b 'last-played) '(0 0 0))))))) + +(defun emms-playlist-sort-by-play-count () + "Sort emms playlist by play-count, increasingly. +With a prefix argument, decreasingly." + (interactive) + (emms-playlist-sort + '(lambda (a b) + (funcall + (if current-prefix-arg 'not 'identity) + (< (or (emms-track-get a 'play-count) 0) + (or (emms-track-get b 'play-count) 0)))))) + +(defun emms-playlist-sort-by-file-extension () + "Sort emms playlist by file extension, increasingly. +With a prefix argument, decreasingly." + (interactive) + (emms-playlist-sort + '(lambda (a b) + (funcall + (if current-prefix-arg 'emms-string> 'emms-string<) + (file-name-extension (emms-track-get a 'name)) + (file-name-extension (emms-track-get b 'name)))))) + +(defun emms-playlist-sort-by-file-mtime () + "Sort emms playlist by file mtime, newest first. +With a prefix argument, oldest first." + (interactive) + (emms-playlist-sort + '(lambda (a b) + (funcall + (if current-prefix-arg + 'time-less-p + (lambda (t1 t2) (not (time-less-p t1 t2)))) + (emms-info-track-file-mtime a) + (emms-info-track-file-mtime b))))) + + +(defvar emms-playlist-sort-map nil) + +(defun emms-playlist-sort-map-setup () + "Setup sort map with latest `emms-playlist-sort-prefix'." + (setq emms-playlist-sort-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") #'emms-playlist-sort-by-natural-order) + (define-key map (kbd "a") #'emms-playlist-sort-by-info-artist) + (define-key map (kbd "c") #'emms-playlist-sort-by-play-count) + (define-key map (kbd "b") #'emms-playlist-sort-by-info-album) + (define-key map (kbd "l") #'emms-playlist-sort-by-last-played) + (define-key map (kbd "t") #'emms-playlist-sort-by-info-title) + (define-key map (kbd "e") #'emms-playlist-sort-by-file-extension) + + (define-key map (kbd "p") #'emms-playlist-sort-by-info-performer) + (define-key map (kbd "y") #'emms-playlist-sort-by-info-year) + (define-key map (kbd "o") #'emms-playlist-sort-by-info-note) + (define-key map (kbd "C") #'emms-playlist-sort-by-info-composer) + (define-key map (kbd "L") #'emms-playlist-sort-by-list) + (define-key map (kbd "N") #'emms-playlist-sort-by-name) + (define-key map (kbd "T") #'emms-playlist-sort-by-file-mtime) + map)) + + (define-key emms-playlist-mode-map + emms-playlist-sort-prefix emms-playlist-sort-map)) + +(setq emms-playlist-sort-map (emms-playlist-sort-map-setup)) + + +;;; Low Level Functions + +(defun emms-playlist-sort (predicate) + "Sort the playlist buffer by PREDICATE." + (emms-with-inhibit-read-only-t + (emms-playlist-ensure-playlist-buffer) + (let ((current (emms-playlist-selected-track)) + (tracks (nreverse + (emms-playlist-tracks-in-region + (point-min) (point-max))))) + (delete-region (point-min) (point-max)) + (run-hooks 'emms-playlist-cleared-hook) + (mapc #'emms-playlist-insert-track (sort tracks predicate)) + (let ((pos (when current (text-property-any (point-min) (point-max) + 'emms-track current)))) + (if pos + (emms-playlist-select pos) + (emms-playlist-first))) + (goto-char (point-min))))) + +(defun emms-sort-natural-order-less-p (a b) + "Sort two tracks by natural order. +This is the order in which albums where intended to be played. +ie. by album name and then by track number." + (let ((album-a (emms-track-get a 'info-album)) + (album-b (emms-track-get b 'info-album)) + (discnum-a (string-to-number (or (emms-track-get a 'info-discnumber) "0"))) + (discnum-b (string-to-number (or (emms-track-get b 'info-discnumber) "0"))) + (tracknum-a (string-to-number (or (emms-track-get a 'info-tracknumber) "0"))) + (tracknum-b (string-to-number (or (emms-track-get b 'info-tracknumber) "0")))) + (or (emms-string< album-a album-b) + (and album-a album-b + (string= album-a album-b) + (or (< discnum-a discnum-b) + (and (= discnum-a discnum-b) + (< tracknum-a tracknum-b))))))) + +(defun emms-playlist-sort-by-list-p (a b) + (catch 'return + (dolist (info emms-playlist-sort-list) + (cl-case info + ((name info-artist info-composer info-performer info-title info-album info-genre) + (when (emms-string< (emms-track-get a info) + (emms-track-get b info)) + (throw 'return t))) + ((info-playing-time) + (when (< (emms-track-get a info) + (emms-track-get b info)) + (throw 'return t))) + ((info-tracknumber info-discnumber) + (when (< (string-to-number (or (emms-track-get a info) "0")) + (string-to-number (or (emms-track-get b info) "0"))) + (throw 'return t))))))) + +(defun emms-string< (s1 s2) + (string< (downcase (or s1 "")) (downcase (or s2 "")))) + +(defun emms-string> (s1 s2) + (let ((a (downcase (or s1 ""))) + (b (downcase (or s2 "")))) + (not (or (string= a b) (string< a b))))) + +(provide 'emms-playlist-sort) + +;;; emms-playlist-sort.el ends here diff --git a/elisp/emms-score.el b/elisp/emms-score.el new file mode 100644 index 0000000..e9fb530 --- /dev/null +++ b/elisp/emms-score.el @@ -0,0 +1,271 @@ +;;; emms-score.el --- Scoring system for mp3player -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2021 Free Software Foundation, Inc. + +;; Authors: Jean-Philippe Theberge , +;; Yoni Rabkin +;; +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; NOTE: This is experimental stuff - comments welcome! There +;; shouldn't worky anything in that file... scores aren't saved, they +;; even don't have any consequence on playing order and there's just +;; one mood in the moment. But it's a beginning and you can score down +;; or up tracks... :) +;; +;; * How to use scoring in emms +;; +;; When you load emms, you are set to a default mood +;; 'emms-default-mood' A mood is a one word string describing how +;; you feel (like "funny", "tired", "aggresive"...) Each mood have is +;; own set of scoring rules. +;; +;; You can change your mood with M-x emms-score-change-mood. +;; +;; Every music file start with a default score of 0 the command +;; emms-score-up-playing and emms-score-down-playing modify the +;; score of the file you are curently listening by 1 In addition, +;; skipping a file (with emms-skip) automaticaly score the file +;; down. +;; +;; With scoring on (this mean the variable emms-use-scoring is t), +;; emms will compare the score of the file with your tolerance to +;; decide if it is played or not. +;; +;; The default tolerance level is 0 (or the variable +;; emms-score-min-score). This mean files with a score of 0 or more will +;; be played and files with a score of -1 or less will be skipped. +;; +;; You can change the tolerance (by 1) with M-x +;; emms-score-lower-tolerance and M-x +;; emms-score-be-more-tolerant + +;;; Code: + +(require 'emms) + +(defvar emms-scores-list nil) +(defvar emms-score-current-mood 'default) +(defvar emms-score-min-score 0) +(defvar emms-score-default-score 0) +(defvar emms-score-hash (make-hash-table :test 'equal)) +(defvar emms-score-enabled-p nil + "If non-nil, emms score is active.") + +(defcustom emms-score-file (concat (file-name-as-directory emms-directory) "scores") + "*Directory to store the score file." + :type 'directory + :group 'emms) + + +;;; User Interfaces + +(defun emms-score (arg) + "Turn on emms-score if prefix argument ARG is a positive integer, +off otherwise." + (interactive "p") + (if (and arg (> arg 0)) + (progn + (setq emms-score-enabled-p t) + (emms-score-load-hash) + (setq emms-ok-track-function #'emms-score-ok-track-function) + (unless noninteractive + (add-hook 'kill-emacs-hook #'emms-score-save-hash))) + (setq emms-score-enabled-p nil) + (emms-score-save-hash) + (setq emms-ok-track-function #'emms-default-ok-track-function) + (remove-hook 'kill-emacs-hook #'emms-score-save-hash))) + +;;;###autoload +(defun emms-score-enable () + "Turn on emms-score." + (interactive) + (emms-score 1) + (message "emms score enabled")) + +;;;###autoload +(defun emms-score-disable () + "Turn off emms-score." + (interactive) + (emms-score -1) + (message "emms score disabled")) + +;;;###autoload +(defun emms-score-toggle () + "Toggle emms-score." + (interactive) + (if emms-score-enabled-p + (emms-score-disable) + (emms-score-enable))) + +(defun emms-score-change-mood (mood) + "Change the current MOOD. +The score hash is automatically saved." + (interactive "sMood: ") + (emms-score-save-hash) + (setq emms-score-current-mood (intern (downcase mood)))) + +(defun emms-score-up-playing () + (interactive) + (if emms-player-playing-p + (emms-score-change-score 1 (emms-score-current-selected-track-filename)) + (error "No track currently playing"))) + +(defun emms-score-down-playing () + (interactive) + (if emms-player-playing-p + (emms-score-change-score -1 (emms-score-current-selected-track-filename)) + (error "No track currently playing"))) + +(defun emms-score-up-file-on-line () + (interactive) + (emms-score-change-score 1 (emms-score-track-at-filename))) + +(defun emms-score-down-file-on-line () + (interactive) + (emms-score-change-score -1 (emms-score-track-at-filename))) + +(defun emms-score-less-tolerant () + "Only play mp3 with a higher score" + (interactive) + (setq emms-score-min-score (+ emms-score-min-score 1)) + (message "Will play songs with a score >= %d" emms-score-min-score)) + +(defun emms-score-more-tolerant () + "Allow playing of mp3 with a lower score." + (interactive) + (setq emms-score-min-score (- emms-score-min-score 1)) + (message "Will play songs with a score >= %d" emms-score-min-score)) + +(defun emms-score-set-playing (score) + "Set score for current playing track." + (interactive "nSet score for playing track: ") + (let ((filename (emms-score-current-selected-track-filename))) + (if emms-player-playing-p + (emms-score-change-score + (- score (emms-score-get-score filename)) + filename) + (error "No track currently playing")))) + +(defun emms-score-set-file-on-line (score) + "Set score for track at point in emms-playlist buffer." + (interactive "nSet score for track at point: ") + (let ((filename (emms-score-track-at-filename))) + (if emms-player-playing-p + (emms-score-change-score + (- score (emms-score-get-score filename)) + filename)))) + +(defun emms-score-set-tolerance (tolerance) + "Allow playing tracks with a score >= tolerance." + (interactive "nSet tolerance: ") + (setq emms-score-min-score tolerance) + (message "Will play songs with a score >= %d" emms-score-min-score)) + +(defun emms-score-show-playing () + "Show score for current playing track in minibuf." + (interactive) + (message "track/tolerance score: %d/%d" + (emms-score-get-score + (emms-score-current-selected-track-filename)) + emms-score-min-score)) + +(defun emms-score-show-file-on-line () + "Show score for track at point in emms-playlist buffer." + (interactive) + (message "track/tolerance score: %d/%d" + (emms-score-get-score + (emms-score-track-at-filename)) + emms-score-min-score)) + + +;;; Internal Functions + +(defun emms-score-current-selected-track-filename () + "Return filename of current selected track." + (emms-track-get (emms-playlist-current-selected-track) 'name)) + +(defun emms-score-track-at-filename () + "Return file of track at point in emms-playlist buffer." + (emms-track-get (emms-playlist-track-at) 'name)) + +(defun emms-score-ok-track-function (track) + "Decide if to skip or play TRACK." + (emms-score-check-score (emms-track-get track 'name))) + +(defun emms-score-save-hash () + "Save score hash in `emms-score-file'." + (interactive) + (unless (file-directory-p (file-name-directory emms-score-file)) + (make-directory (file-name-directory emms-score-file))) + (with-temp-file emms-score-file + (let ((standard-output (current-buffer))) + (insert "(") + (maphash (lambda (key value) + (prin1 (cons key value))) + emms-score-hash) + (insert ")")))) + +(defun emms-score-load-hash () + "Load score hash from `emms-score-file'." + (interactive) + (if (file-exists-p emms-score-file) + (let ((score-string (with-temp-buffer + (emms-insert-file-contents emms-score-file) + (buffer-string)))) + (if (> (length score-string) 0) + (mapc (lambda (elt) + (puthash (car elt) (cdr elt) emms-score-hash)) + (read score-string))) + ;; when file not exists, make empty but valid score file + (emms-score-save-hash)))) + +(defun emms-score-get-plist (filename) + (gethash filename emms-score-hash)) + +(defun emms-score-change-score (score filename) + (let ((sp (emms-score-get-plist filename) ) + (sc (emms-score-get-score filename))) + (puthash filename + (plist-put sp emms-score-current-mood (+ sc score)) + emms-score-hash) + (message "New score is %s" (+ score sc)))) + +(defun emms-score-create-entry (filename) + (puthash filename + `(,emms-score-current-mood ,emms-score-default-score) + emms-score-hash)) + +(defun emms-score-get-score (filename) + "Return score of TRACK." + (let ((plist (emms-score-get-plist filename))) + (if (member emms-score-current-mood plist) + (plist-get plist emms-score-current-mood) + (emms-score-create-entry filename) + (emms-score-get-score filename)))) + +(defun emms-score-check-score (filename) + (>= (emms-score-get-score filename) emms-score-min-score)) + +(provide 'emms-score) + +;;; emms-scores.el ends here diff --git a/elisp/emms-setup.el b/elisp/emms-setup.el new file mode 100644 index 0000000..e96ccea --- /dev/null +++ b/elisp/emms-setup.el @@ -0,0 +1,200 @@ +;;; emms-setup.el --- Setup script for EMMS -*- lexical-binding: t; -*- + +;; Copyright (C) 2005-2022 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin +;; Keywords: emms setup multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file provides the `emms-setup' feature. With `emms-setup' we +;; can setup Emms with different features enabled. The use of this +;; feature is documented in the Emms manual which is distributed with +;; Emms. +;; +;; The use this feature we can invoke (for example): +;; +;; (require 'emms-setup) +;; (emms-all) +;; +;; The first command loads the feature into Emacs and the second +;; chooses the `emms-all' level. + +;;; Code: + +(require 'emms) + +(defgroup emms-setup nil + "*The Emacs Multimedia System setup utility." + :prefix "emms-setup" + :group 'multimedia) + +(defcustom emms-setup-default-player-list + '(emms-player-mpg321 + emms-player-ogg123 + emms-player-mplayer-playlist + emms-player-mplayer + emms-player-mpv + emms-player-vlc + emms-player-vlc-playlist) + "Default list of players for emms-setup." + :type 'list) + +(defvar emms-setup-discover-player-alist + '((emms-player-mpg321 . "mpg123") + (emms-player-ogg123 . "ogg123") + (emms-player-mplayer . "mplayer") + (emms-player-mpv . "mpv") + (emms-player-vlc . "vlc")) + "Association list of players and their binaries.") + +;;;###autoload +(defun emms-minimalistic () + "An Emms setup script. +Invisible playlists and all the basics for playing media." + (require 'emms-source-file) + (require 'emms-source-playlist) + (require 'emms-player-simple) + (require 'emms-player-mplayer) + (require 'emms-player-mpv) + (require 'emms-player-vlc)) + +;;;###autoload +(defun emms-all () + "An Emms setup script. +Everything included in the `emms-minimalistic' setup and adds all +the stable features which come with the Emms distribution." + ;; include + (emms-minimalistic) + ;; define + (eval-and-compile + (require 'emms-playlist-mode) + (require 'emms-info) + (require 'emms-info-mp3info) + (require 'emms-info-ogginfo) + (require 'emms-info-opusinfo) + (require 'emms-info-metaflac) + (require 'emms-info-tinytag) + (require 'emms-info-exiftool) + (require 'emms-info-native) + (require 'emms-cache) + (require 'emms-mode-line) + (require 'emms-mark) + (require 'emms-tag-editor) + (require 'emms-tag-tracktag) + (require 'emms-show-all) + (require 'emms-streams) + (require 'emms-lyrics) + (require 'emms-playing-time) + (require 'emms-player-mpd) + (require 'emms-player-xine) + (require 'emms-playlist-sort) + (require 'emms-browser) + (require 'emms-mode-line-icon) + (require 'emms-cue) + (require 'emms-bookmarks) + (require 'emms-last-played) + (require 'emms-metaplaylist-mode) + (require 'emms-stream-info) + (require 'emms-score) + (require 'emms-history) + (require 'emms-i18n) + (require 'emms-volume) + (require 'emms-playlist-limit) + (require 'emms-librefm-scrobbler) + (require 'emms-librefm-stream) + (require 'emms-mpris)) + ;; setup + (setq emms-playlist-default-major-mode #'emms-playlist-mode) + (add-to-list 'emms-track-initialize-functions #'emms-info-initialize-track) + (setq emms-info-functions '(emms-info-native emms-info-cueinfo)) + (setq emms-track-description-function #'emms-info-track-description) + (when (fboundp 'emms-cache) ; work around compiler warning + (emms-cache 1)) + (emms-mode-line-mode 1) + (emms-mode-line-blank) + (emms-lyrics 1) + (emms-playing-time-mode 1) + (add-hook 'emms-player-started-hook #'emms-last-played-update-current) + (emms-score 1)) + + +;;;###autoload +(defun emms-default-players () + "Set `emms-player-list' to `emms-setup-default-player-list'." + (setq emms-player-list + emms-setup-default-player-list)) + + + +;; These are kept around in order not to break anyone's existing +;; setup. +;;;###autoload +(defun emms-devel () + (emms-all)) +(make-obsolete 'emms-devel 'emms-all "4.1") + +;;;###autoload +(defun emms-standard () + (emms-all)) +(make-obsolete 'emms-standard 'emms-all "4.1") + + +;;; ------------------------------------------------------------------ +;;; Player discovery +;;; ------------------------------------------------------------------ +(defun emms-setup-discover-player-binary (bin-str) + "Find if BIN-STR can be executed in the current environment." + (when (not (eq system-type 'gnu/linux)) + (error "Player discovery only supported on GNU/Linux.")) + (let ((result (call-process "which" nil nil nil bin-str))) + (cond ((eq 0 result) t) + ((eq 1 result) nil) + ((eq 2 result) (error "invalid arguments to `which'."))))) + +(defun emms-setup-discover-player-has-binary-p (player) + "Find if PLAYER has an excecutable in the current environment." + (let ((bin-str (alist-get player emms-setup-discover-player-alist))) + (if bin-str + (emms-setup-discover-player-binary bin-str) + nil))) + +(defun emms-setup-discover-players () + "Interactively add players to `emms-player-list'." + (interactive) + (when (and emms-player-list + (y-or-n-p (format "emms-player-list is already set to %s, do you want to empty it first?" + emms-player-list))) + (setq emms-player-list nil)) + (let ((players (copy-tree emms-setup-default-player-list))) + (while players + (let ((player (car players))) + (when (emms-setup-discover-player-has-binary-p player) + (when (y-or-n-p + (format "Player %s is installed on your system, add it to the Emms player list?" + player)) + (add-to-list 'emms-player-list player)))) + (setq players (cdr players)))) + (message "emms-player-list is now set to: %s" emms-player-list)) + + + +(provide 'emms-setup) +;;; emms-setup.el ends here diff --git a/elisp/emms-show-all.el b/elisp/emms-show-all.el new file mode 100644 index 0000000..b08e5bd --- /dev/null +++ b/elisp/emms-show-all.el @@ -0,0 +1,125 @@ +;;; emms-show-all.el --- Detailed track information for Emms. -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Shows all of the available information Emms can provide on the +;; currently playing track. Based on an idea suggested on the +;; emms-help mailing list by Ivan Truskov. + +;;; Code: + +(require 'emms) +(require 'emms-tag-editor) + + +(defvar emms-show-all-buffer-name "Emms Track Information" + "Name of buffer used by `emms-show-all'.") + +(defvar emms-show-all-kill-buffer-on-quit-p nil + "If t, kill the show-all buffer when quitting.") + +(defvar emms-show-all-track-alist nil + "Declare so as to silence the compiler.") + +(defvar emms-show-all-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map (kbd "q") #'emms-show-all-mode-bury-buffer) + (define-key map (kbd "E") #'emms-show-all-edit-track) + map) + "Keymap for `emms-show-all-mode'.") + +(define-derived-mode emms-show-all-mode text-mode "Emms-Show-All" + "Major mode for `emms-show-all' + \\{emms-show-all-mode-map}") + +(defun emms-show-all-edit-track () + "Edit the track being shown." + (interactive) + (let ((track emms-show-all-track-alist)) + (emms-show-all-mode-bury-buffer) + (emms-tag-editor-edit-track track))) + +(defun emms-show-all-mode-bury-buffer () + "Bury, and optionally kill the show buffer." + (interactive) + (quit-restore-window + (selected-window) + (when emms-show-all-kill-buffer-on-quit-p 'kill))) + +(defun emms-show-all-setup-buffer () + "Prepare the display buffer." + (let ((buffer (get-buffer-create emms-show-all-buffer-name))) + (with-current-buffer buffer + (when (not (local-variable-p 'emms-show-all-track-alist)) + (make-local-variable 'emms-show-all-track-alist)) + (setq buffer-read-only t) + (when (not (equal major-mode 'emms-show-all-mode)) + (emms-show-all-mode)) + (let ((inhibit-read-only t)) + (erase-buffer))) + buffer)) + +(defun emms-show-all-format (track) + "Format information for TRACK." + (let ((s "")) + (dolist (e (mapcar #'(lambda (tag) + (cons + (format "%s" (car tag)) + (or (emms-track-get track (car tag)) ""))) + emms-tag-editor-tags)) + (setq s (concat s (format "%-17s: %s\n" (car e) (cdr e))))) + s)) + +(defun emms-show-all-insert (track) + "Insert information for TRACK in current buffer." + (let ((type (emms-track-type track))) + (cond ((eq 'file type) + (insert (emms-show-all-format track))) + ((eq 'url type) + (insert + (emms-format-url-track-name (emms-track-name track)))) + (t (concat (symbol-name type) + ": " (emms-track-name track)))))) + +(defun emms-show-all-track (track) + "Display information for TRACK." + (let ((buffer (emms-show-all-setup-buffer))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (setq emms-show-all-track-alist track) + (emms-show-all-insert track)) + (pop-to-buffer (current-buffer))))) + +(defun emms-show-all () + "Describe the current EMMS track in detail." + (interactive) + (if emms-player-playing-p + (emms-show-all-track + (emms-playlist-current-selected-track)) + (message "nothing playing right now"))) + + +(provide 'emms-show-all) + +;;; emms-playlist-mode.el ends here diff --git a/elisp/emms-source-file.el b/elisp/emms-source-file.el new file mode 100644 index 0000000..7186a92 --- /dev/null +++ b/elisp/emms-source-file.el @@ -0,0 +1,309 @@ +;;; emms-source-file.el --- EMMS sources from the filesystem. -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2021 Free Software Foundation, Inc. + +;; Author: Jorgen Schäfer +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file contains a track source for EMMS that is based on the +;; file system. You can retrieve single files or whole directories. +;; Also, this file offers the commands to play from these sources. + +;;; Code: + +;; Version control +(defvar emms-source-file-version "0.2 $Revision: 1.30 $" + "emms-source-file.el version string") +;; $Id: emms-source-file.el,v 1.30 2005/08/11 06:16:15 yonirabkin Exp $ + +;;; User Customization + +(require 'emms) +(require 'dired) +(require 'locate) +(eval-when-compile + (condition-case nil + (require 'locate) + (error nil))) +(require 'dired) +(require 'thingatpt) + +(defgroup emms-source-file nil + "*Sources for EMMS that use the file system." + :prefix "emms-source-file-" + :group 'emms-source) + +(defcustom emms-source-file-default-directory nil + "The default directory to look for media files." + :type '(choice (const :tag "None" nil) file)) + +(defcustom emms-source-file-directory-tree-function + 'emms-source-file-directory-tree-internal + "*A function to call that searches in a given directory all files +that match a given regex. DIR and REGEX are the only arguments passed +to this function. +You have two build-in options: +`emms-source-file-directory-tree-internal' will work always, but might +be slow. +`emms-source-file-directory-tree-find' will work only if you have GNU +find, but it's faster." + :type 'function + :options '(emms-source-file-directory-tree-internal + emms-source-file-directory-tree-find)) + +(defcustom emms-source-file-exclude-regexp + (concat "\\`\\(#.*#\\|.*,v\\|.*~\\|\\.\\.?\\|\\.#.*\\|,.*\\)\\'\\|" + "/\\(CVS\\|RCS\\|\\.arch-ids\\|{arch}\\|,.*\\|\\.svn\\|" + "_darcs\\)\\(/\\|\\'\\)") + "A regexp matching files to be ignored when adding directories. + +You should set case-fold-search to nil before using this regexp +in code." + :type 'regexp) + +(defcustom emms-source-file-gnu-find "find" + "The program name for GNU find." + :type 'string) + +(defcustom emms-source-file-directory-hint-p t + "When non-nil, guess the directory based on a track at point." + :type 'boolean) + +;; The `read-directory-name' function is not available in Emacs 21. +(defalias 'emms-read-directory-name + (if (fboundp 'read-directory-name) + #'read-directory-name + #'read-file-name)) + +(defun emms-source-file-directory-hint () + (if (and emms-source-file-directory-hint-p + emms-playlist-buffer-p + (emms-playlist-track-at)) + (let ((name (emms-track-get (emms-playlist-track-at) 'name)) + (type (emms-track-get (emms-playlist-track-at) 'type))) + (when (eq type 'file) + (file-name-directory name))) + emms-source-file-default-directory)) + + +;;; Sources + +;;;###autoload (autoload 'emms-play-file "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-file "emms-source-file" nil t) +(define-emms-source file (file) + "An EMMS source for a single file - either FILE, or queried from the +user." + (interactive (list (read-file-name "Play file: " + (emms-source-file-directory-hint) + emms-source-file-default-directory + t))) + (if (file-directory-p file) + (emms-source-directory file) + (emms-playlist-insert-track + (emms-track 'file (expand-file-name file))))) + +;;;###autoload (autoload 'emms-play-directory "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-directory "emms-source-file" nil t) +(define-emms-source directory (dir) + "An EMMS source for a whole directory tree - either DIR, or queried +from the user." + (interactive (list + (emms-read-directory-name "Play directory: " + (emms-source-file-directory-hint) + emms-source-file-default-directory + t))) + (mapc (lambda (file) + (unless (or (let ((case-fold-search nil)) + (string-match emms-source-file-exclude-regexp file)) + (file-directory-p file)) + (emms-playlist-insert-track + (emms-track 'file (expand-file-name file))))) + (directory-files dir t (emms-source-file-regex)))) + +;;;###autoload (autoload 'emms-play-directory-tree "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-directory-tree "emms-source-file" nil t) +(define-emms-source directory-tree (dir) + "An EMMS source for multiple directory trees - either DIR, or the +value of `emms-source-file-default-directory'." + (interactive (list + (emms-read-directory-name "Play directory tree: " + (emms-source-file-directory-hint) + emms-source-file-default-directory + t))) + (let ((files (emms-source-file-directory-tree (expand-file-name dir) + (emms-source-file-regex))) + (case-fold-search nil)) + (emms-playlist-ensure-playlist-buffer) + (mapc (lambda (file) + (unless (string-match emms-source-file-exclude-regexp file) + (funcall emms-playlist-insert-track-function + (emms-track 'file file)))) + files))) + +;;;###autoload (autoload 'emms-play-find "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-find "emms-source-file" nil t) +(define-emms-source find (dir regex) + "An EMMS source that will find files in DIR or +`emms-source-file-default-directory' that match REGEX." + (interactive (list + (emms-read-directory-name "Find in directory: " + emms-source-file-default-directory + emms-source-file-default-directory + t) + (read-from-minibuffer "Find files matching: "))) + (mapc (lambda (file) + (unless (let ((case-fold-search nil)) + (string-match emms-source-file-exclude-regexp file)) + (emms-playlist-insert-track + (emms-track 'file file)))) + (emms-source-file-directory-tree (expand-file-name dir) regex))) + +;;;###autoload (autoload 'emms-play-dired "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-dired "emms-source-file" nil t) +(define-emms-source dired () + "Return all marked files of a dired buffer" + (interactive) + (mapc (lambda (file) + (if (file-directory-p file) + (emms-source-directory-tree file) + (emms-source-file file))) + (with-current-buffer emms-source-old-buffer + (dired-get-marked-files)))) + + +;;; Helper functions + +;;;###autoload +(defun emms-source-file-directory-tree (dir regex) + "Return a list of all files under DIR that match REGEX. +This function uses `emms-source-file-directory-tree-function'." + (message "Building playlist...") + (let ((pl (sort (funcall emms-source-file-directory-tree-function + dir + regex) + #'string<))) + (message "Building playlist...done") + pl)) + +(defun emms-source-file-directory-tree-internal (dir regex) + "Return a list of all files under DIR that match REGEX. +This function uses only emacs functions, so it might be a bit slow." + (let ((files '()) + (dirs (list dir))) + (while dirs + (cond + ((file-directory-p (car dirs)) + (if (or (string-match "/\\.\\.?$" (car dirs)) + (let ((symlink (file-symlink-p (car dirs)))) + (and symlink + (string-equal dir (substring symlink 0 (string-width dir)))))) + (setq dirs (cdr dirs)) + (setq dirs + (condition-case nil + (append (cdr dirs) + (directory-files (car dirs) + t nil t)) + (error + (cdr dirs)))))) + ((string-match regex (car dirs)) + (setq files (cons (car dirs) files) + dirs (cdr dirs))) + (t + (setq dirs (cdr dirs))))) + files)) + +(defun emms-source-file-directory-tree-find (dir regex) + "Return a list of all files under DIR that match REGEX. +This function uses the external find utility. The name for GNU find +may be supplied using `emms-source-file-gnu-find'." + (with-temp-buffer + (call-process emms-source-file-gnu-find + nil t nil + "-L" ; follow symlinks + (expand-file-name dir) + "-type" "f" + "-iregex" (concat ".*\\(" regex "\\).*")) + (delete "" + (split-string (buffer-substring (point-min) + (point-max)) + "\n")))) + +(defmacro emms-with-excluded-directories (directory-list &rest body) + "Run BODY while excluding DIRECTORY-LIST." + `(let ((emms-source-file-exclude-regexp + (concat (or ,emms-source-file-exclude-regexp "") + "\\|\\(" + (or (regexp-opt ,directory-list) "") + "\\)"))) + ,@body)) + +;;;###autoload +(defun emms-source-file-regex () + "Return a regexp that matches everything any player (that supports +files) can play." + (mapconcat (lambda (player) + (or (emms-player-get player 'regex) + "")) + emms-player-list + "\\|")) + +;; emms-locate should be part of a once to be emms-dired, with maybe +;; file rename after tag functions and so on, but till then i park it +;; here... :) + +;;;###autoload +(defun emms-locate (regexp) + "Search for REGEXP and display the results in a locate buffer" + (interactive "sRegexp to search for: ") + (require 'locate) + (save-window-excursion + (set-buffer (get-buffer-create "*EMMS Find*")) + (locate-mode) + (erase-buffer) + (mapc (lambda (elt) (insert (cdr (assoc 'name elt)) "\n")) + (emms-source-find emms-source-file-default-directory regexp)) + (locate-do-setup regexp)) + (and (not (string-equal (buffer-name) "*EMMS Find*")) + (switch-to-buffer-other-window "*EMMS Find*")) + (run-hooks 'dired-mode-hook) + (dired-next-line 2)) + +;; Strictly speaking, this does not belong in this file (URLs are not +;; real files), but it's close enough :-) + +;;;###autoload (autoload 'emms-play-url "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-url "emms-source-file" nil t) +(define-emms-source url (url) + "An EMMS source for an URL - for example, for streaming." + (interactive (list (read-string "Play URL: " (thing-at-point-url-at-point)))) + (emms-playlist-insert-track (emms-track 'url url))) + +;;;###autoload (autoload 'emms-play-streamlist "emms-source-file" nil t) +;;;###autoload (autoload 'emms-add-streamlist "emms-source-file" nil t) +(define-emms-source streamlist (streamlist) + "An EMMS source for streaming playlists (usually URLs ending in .pls)." + (interactive "sPlay streamlist URL: ") + (emms-playlist-insert-track (emms-track 'streamlist streamlist))) + + +(provide 'emms-source-file) +;;; emms-source-file.el ends here diff --git a/elisp/emms-source-playlist.el b/elisp/emms-source-playlist.el new file mode 100644 index 0000000..fd1036d --- /dev/null +++ b/elisp/emms-source-playlist.el @@ -0,0 +1,502 @@ +;;; emms-source-playlist.el --- EMMS sources from playlist files -*- lexical-binding: t; -*- + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2023 Free Software Foundation, Inc. + +;; Author: Jorgen Schäfer +;; Keywords: emms, mp3, mpeg, multimedia + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file contains track sources for EMMS which read playlist +;; files. EMMS' own playlist files are supported as well as .m3u and +;; .pls files. + +;;; Code: + +;; Version control +(defvar emms-source-playlist-version "0.5 $Revision: 1.30 $" + "emms-source-playlist.el version string") +;; $Id: emms-source-file.el,v 1.30 2005/08/11 06:16:15 yonirabkin Exp $ + +(require 'emms) +(require 'emms-source-file) + +(defcustom emms-source-playlist-formats '(native pls m3u) + "*A list of playlist formats. +Each entry must have at least three corresponding functions. + +First, a function named `emms-source-playlist-FORMAT-p' which +returns non-nil if the current buffer is of the type FORMAT. It +is called with no arguments. + +Second, a function named `emms-source-playlist-parse-FORMAT' +which parses the current buffer into tracks. It is called with +no arguments. + +Third, a function named `emms-source-playlist-unparse-FORMAT' +which creates an output file in the type FORMAT that contains the +tracks of a playlist buffer. It is called with two arguments: +The playlist buffer and the file buffer. + +It is also recommended to have a function named +`emms-source-playlist-FORMAT-files' which returns a list of the +files contained in the playlist." + :type '(repeat (symbol :tag "Format")) + :group 'emms) + +(defcustom emms-source-playlist-default-format nil + "*The default format to use for saving playlists. +If this is nil, you will be prompted for a format to use." + :type '(choice (const :tag "Prompt each time" nil) + (const :tag "Native" native) + (const :tag "m3u" m3u) + (const :tag "pls" pls) + (symbol :tag "Other")) + :group 'emms) + +(defcustom emms-source-playlist-ask-before-overwrite t + "*Ask before saving over an existing playlist. +If this is nil, existing playlists will be quietly overwritten." + :type 'boolean + :group 'emms) + +(defvar emms-source-playlist-native-header-line + ";;; This is an EMMS playlist file" + "Line which identifies a native emms playlist.") + +;;; General playlist + +(defsubst emms-source-playlist-p-sym (format) + (intern (concat "emms-source-playlist-" (symbol-name format) "-p"))) + +(defsubst emms-source-playlist-parse-sym (format) + (intern (concat "emms-source-playlist-parse-" (symbol-name format)))) + +(defsubst emms-source-playlist-unparse-sym (format) + (intern (concat "emms-source-playlist-unparse-" (symbol-name format)))) + +(defsubst emms-source-playlist-files-sym (format) + (intern (concat "emms-source-playlist-" (symbol-name format) "-files"))) + +(defun emms-source-playlist-p (format &optional parse-files) + (let ((sym (emms-source-playlist-p-sym format))) + (when (and (functionp sym) + (or (not parse-files) + (functionp (emms-source-playlist-files-sym format)))) + (funcall sym)))) + +(defun emms-source-playlist-parse (format file) + (funcall (emms-source-playlist-parse-sym format) file)) + +(defun emms-source-playlist-unparse (format playlist-buf file-buf) + (funcall (emms-source-playlist-unparse-sym format) playlist-buf file-buf)) + +(defun emms-source-playlist-files (format) + (let ((sym (emms-source-playlist-files-sym format))) + (if (functionp sym) + (funcall sym) + (error "The `%s' format cannot parse files from a playlist" format)))) + +(defvar emms-source-playlist-format-history nil + "List of recently-entered formats; used by `emms-playlist-save'.") + +(defun emms-source-playlist-read-format () + "Read a playlist format from the user. +If `emms-source-playlist-default-format' is non-nil, use it +instead of prompting the user." + (or emms-source-playlist-default-format + (let ((format + (emms-completing-read + (concat "Playlist format: (default: " + (if emms-source-playlist-format-history + (car emms-source-playlist-format-history) + "native") + ") ") + (mapcar #'symbol-name emms-source-playlist-formats) + nil nil nil 'emms-source-playlist-format-history + (if emms-source-playlist-format-history + (car emms-source-playlist-format-history) + "native")))) + ;; Sometimes the completion function can put partial results + ;; onto the history, so pop the last one off and include the + ;; completed version instead. + (setq emms-source-playlist-format-history + (cons format + (cdr emms-source-playlist-format-history))) + (intern format)))) + +(defun emms-playlist-save (format file) + "Store the current playlist to FILE as the type FORMAT. +The default format is specified by `emms-source-playlist-default-format'." + (interactive (list (emms-source-playlist-read-format) + (read-file-name "Store as: " + emms-source-file-default-directory + emms-source-file-default-directory + nil))) + (if (or (eq emms-playlist-buffer (current-buffer)) + (and (not (eq emms-playlist-buffer (current-buffer))) + (y-or-n-p + (format "Current playlist buffer (%s) is not the one you are visiting (%s). Save anyway?" + emms-playlist-buffer (current-buffer))))) + (with-temp-buffer + (emms-source-playlist-unparse format + (with-current-emms-playlist + (current-buffer)) + (current-buffer)) + (let ((backup-inhibited t)) + (write-file file emms-source-playlist-ask-before-overwrite))) + (message "aborting save"))) + +(defun emms-source-playlist-determine-format (&optional parse-files) + "Determine the playlist format of the current buffer. +If PARSE-FILES is specified, the given format must be able to +return a list of the files contained in the playlist." + (catch 'return + (let ((formats emms-source-playlist-formats)) + (while formats + (when (emms-source-playlist-p (car formats) parse-files) + (throw 'return (car formats))) + (setq formats (cdr formats)))))) + +;;;###autoload (autoload 'emms-play-playlist "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-playlist "emms-source-playlist" nil t) +(define-emms-source playlist (file) + "An EMMS source for playlists. +See `emms-source-playlist-formats' for a list of supported formats." + (interactive (list (read-file-name "Playlist file: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc #'emms-playlist-insert-track + (with-temp-buffer + (emms-insert-file-contents file) + (goto-char (point-min)) + (let ((format (emms-source-playlist-determine-format))) + (if format + (emms-source-playlist-parse format file) + (error "Not a recognized playlist format")))))) + +;;; Emms native playlists + +;; An Emms native playlist file starts with the contents of +;; `emms-source-playlist-native-header-line' and is followed by +;; tracks in sexp format. + +(defun emms-source-playlist-native-p () + "Return non-nil if the current buffer contains a native EMMS playlist." + (save-excursion + (goto-char (point-min)) + (looking-at (concat "^" emms-source-playlist-native-header-line)))) + +(defun emms-source-playlist-parse-native (file) + "Parse the native EMMS playlist in the current buffer." + (ignore file) + (let ((tracks (save-excursion + (goto-char (point-min)) + (read (current-buffer))))) + (mapc (lambda (track) + (funcall emms-cache-set-function + (emms-track-type track) + (emms-track-name track) + track)) + tracks) + tracks)) + +(defun emms-source-playlist-unparse-native (in out) + "Unparse a native playlist from IN to OUT. +IN should be a buffer with a EMMS playlist in it. +OUT should be the buffer where tracks are stored in the native EMMS format." + (with-current-buffer in ;; Don't modify the position + (save-excursion ;; in the IN buffer + (with-current-buffer out + (insert emms-source-playlist-native-header-line + " Play it with M-x emms-play-playlist\n") + (insert "(")) + (let ((firstp t)) + (goto-char (point-min)) + (emms-walk-tracks + (let ((track (emms-playlist-track-at (point)))) + (with-current-buffer out + (if (not firstp) + (insert "\n ") + (setq firstp nil)) + (prin1 track (current-buffer)))))) + (with-current-buffer out + (insert ")\n"))))) + +;;;###autoload (autoload 'emms-play-native-playlist "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-native-playlist "emms-source-playlist" nil t) +(define-emms-source native-playlist (file) + "An EMMS source for a native EMMS playlist file." + (interactive (list (read-file-name "Playlist file: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc #'emms-playlist-insert-track + (with-temp-buffer + (emms-insert-file-contents file) + (goto-char (point-min)) + (when (not (emms-source-playlist-native-p)) + (error "Not a native EMMS playlist file.")) + (emms-source-playlist-parse-native file)))) + +;;; m3u files + +;; Format: +;; Either a list of filename-per-line, ignore lines beginning with # +;; or: +;; #EXTM3U +;; #EXTINF:, +;; + +; emms-source-playlist-m3u-p +; emms-source-playlist-parse-m3u +; emms-source-playlist-m3u-files +; emms-source-playlist-unparse-m3u + +(defun emms-source-playlist-m3u-p () + "Return non-nil if the current buffer contains an m3u playlist. + +We currently have no metric for determining whether a buffer is +an .m3u playlist based on its contents alone, so we assume that +the more restrictive playlist formats have already been +detected and simply return non-nil always." + t) + +(defun emms-source-playlist-parse-m3u (playlist-file) + "Parse the m3u playlist in the current buffer. +Files will be relative to the directory of PLAYLIST-FILE, unless +they have absolute paths." + (let ((dir (file-name-directory playlist-file))) + (mapcar (lambda (file) + (if (string-match "\\`\\(http[s]?\\|mms\\)://" file) + (emms-track 'url file) + (emms-track 'file (expand-file-name file dir)))) + (emms-source-playlist-m3u-files)))) + +(defun emms-source-playlist-m3u-files () + "Extract a list of filenames from the given m3u playlist. + +Empty lines and lines starting with '#' are ignored." + (let ((files nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[^# \n].*$" nil t) + (setq files (cons (match-string 0) files)))) + (nreverse files))) + +(defun emms-source-playlist-unparse-m3u (in out) + "Unparse an m3u playlist from IN to OUT. +IN should be a buffer containing an m3u playlist. +OUT should be the buffer where tracks are stored in m3u format." + (with-current-buffer in ;; Don't modify the position + (save-excursion ;; in the IN buffer + (goto-char (point-min)) + (emms-walk-tracks + (let ((track (emms-playlist-track-at (point)))) + (with-current-buffer out + (insert (emms-track-name track) ?\n))))))) + +;;;###autoload (autoload 'emms-play-m3u-playlist "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-m3u-playlist "emms-source-playlist" nil t) +(define-emms-source m3u-playlist (file) + "An EMMS source for an m3u playlist file." + (interactive (list (read-file-name "Playlist file: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc #'emms-playlist-insert-track + (with-temp-buffer + (emms-insert-file-contents file) + (goto-char (point-min)) + (when (not (emms-source-playlist-m3u-p)) + (error "Not an m3u playlist file.")) + (emms-source-playlist-parse-m3u file)))) + +;;; pls files + +;; Format: +;; A list of one filename per line. +;; [playlist] +;; NumberOfEntries= +;; File= + +; emms-source-playlist-pls-p +; emms-source-playlist-parse-pls +; emms-source-playlist-pls-files +; emms-source-playlist-unparse-pls + +(defun emms-source-playlist-pls-p () + "Return non-nil if the current buffer contains a pls playlist." + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^File[0-9]*=.+$" nil t) + t + nil))) + +(defun emms-source-playlist-parse-pls (playlist-file) + "Parse the pls playlist in the current buffer. +Files will be relative to the directory of PLAYLIST-FILE, unless +they have absolute paths." + (let ((dir (file-name-directory playlist-file))) + (mapcar (lambda (file) + (if (string-match "\\`\\(http[s]?\\|mms\\)://" file) + (emms-track 'url file) + (if (string-match "\\`file://" file) ;; handle file:// uris + (let ((file (url-unhex-string (substring file 7)))) + (emms-track 'file file)) + (emms-track 'file (expand-file-name file dir))))) + (emms-source-playlist-pls-files)))) + + +(defun emms-source-playlist-pls-files () + "Extract a list of filenames from the given pls playlist. + +Empty lines and lines starting with '#' are ignored." + (let ((files nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^File[0-9]*=\\(.+\\)$" nil t) + (setq files (cons (match-string 1) files)))) + (nreverse files))) + +(defun emms-source-playlist-unparse-pls (in out) + "Unparse a pls playlist from IN to OUT. +IN should be a buffer conatining a pls playlist. +OUT should be the buffer where tracks are stored in pls format." + (with-current-buffer in ;; Don't modify the position + (save-excursion ;; in the IN buffer + (let ((pos 0) + beg) + (with-current-buffer out + (insert "[playlist]\n") + (setq beg (point))) + (goto-char (point-min)) + (emms-walk-tracks + (let ((track (emms-playlist-track-at (point)))) + (setq pos (1+ pos)) + (with-current-buffer out + (insert "File" (number-to-string pos) "=" + (emms-track-name track) ?\n)))) + (with-current-buffer out + (goto-char beg) + (insert "NumberOfEntries=" (number-to-string pos) ?\n)))))) + +;;;###autoload (autoload 'emms-play-pls-playlist "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-pls-playlist "emms-source-playlist" nil t) +(define-emms-source pls-playlist (file) + "An EMMS source for a pls playlist file." + (interactive (list (read-file-name "Playlist file: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc #'emms-playlist-insert-track + (with-temp-buffer + (emms-insert-file-contents file) + (goto-char (point-min)) + (when (not (emms-source-playlist-pls-p)) + (error "Not a pls playlist file.")) + (emms-source-playlist-parse-pls file)))) + +;;; extm3u files + +;; Format: +;; #EXTM3U +;; #EXTINF:, +;; + +; emms-source-playlist-extm3u-p +; emms-source-playlist-parse-extm3u +; emms-source-playlist-unparse-extm3u + +;; (erase-buffer) +;; (insert "#EXTM3U\n") +;; (mapc (lambda (track) +;; (let ((time (or (emms-track-get track 'info-mtime) "")) +;; (artist (emms-track-get track 'info-artist)) +;; (title (emms-track-get track 'info-title)) +;; (name (emms-track-get track 'name))) +;; (insert (format "#EXTINF: %s,%s - %s\n%s\n" +;; time artist title name)))) +;; tracklist) +;; (save-buffer) +;; (kill-buffer (current-buffer))))) + +;; Not implemented yet + +;;; Adding playlists as files + +;;;###autoload (autoload 'emms-play-playlist-file "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-playlist-file "emms-source-playlist" nil t) +(define-emms-source playlist-file (file) + "An EMMS source for playlist files. +This adds the given file to the current EMMS playlist buffer, +without adding its contents. + +See `emms-source-playlist-formats' for a list of supported formats." + (interactive (list (read-file-name "Playlist file: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (emms-playlist-insert-track + (emms-track 'playlist (expand-file-name file)))) + +;;;###autoload (autoload 'emms-play-playlist-directory +;;;###autoload "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-playlist-directory +;;;###autoload "emms-source-playlist" nil t) +(define-emms-source playlist-directory (dir) + "An EMMS source for a whole directory tree of playlist files. +If DIR is not specified, it is queried from the user." + (interactive (list + (emms-read-directory-name "Play directory: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc (lambda (file) + (unless (or (let ((case-fold-search nil)) + (string-match emms-source-file-exclude-regexp file)) + (file-directory-p file)) + (emms-playlist-insert-track + (emms-track 'playlist (expand-file-name file))))) + (directory-files dir t "^[^.]"))) + +;;;###autoload (autoload 'emms-play-playlist-directory-tree +;;;###autoload "emms-source-playlist" nil t) +;;;###autoload (autoload 'emms-add-playlist-directory-tree +;;;###autoload "emms-source-file" nil t) +(define-emms-source playlist-directory-tree (dir) + "An EMMS source for multiple directory trees of playlist files. +If DIR is not specified, it is queried from the user." + (interactive (list + (emms-read-directory-name "Play directory tree: " + emms-source-file-default-directory + emms-source-file-default-directory + t))) + (mapc (lambda (file) + (unless (let ((case-fold-search nil)) + (string-match emms-source-file-exclude-regexp file)) + (emms-playlist-insert-track + (emms-track 'playlist file)))) + (emms-source-file-directory-tree (expand-file-name dir) "^[^.]"))) + +(provide 'emms-source-playlist) +;;; emms-source-playlist.el ends here diff --git a/elisp/emms-stream-info.el b/elisp/emms-stream-info.el new file mode 100644 index 0000000..035af43 --- /dev/null +++ b/elisp/emms-stream-info.el @@ -0,0 +1,30 @@ +;;; emms-stream-info.el --- Info from streaming audio -*- lexical-binding: t; -*- + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, +;; 2009, 2019 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3 of the +;; License, or (at your option) any later version. + +;; EMMS 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Code: + +;; to be implemented! + +(provide 'emms-stream-info) + +;;; emms-stream-info.el ends here diff --git a/elisp/emms-streams.el b/elisp/emms-streams.el new file mode 100644 index 0000000..104ca29 --- /dev/null +++ b/elisp/emms-streams.el @@ -0,0 +1,178 @@ +;; emms-streams.el -- A collection of online streaming audio -*- lexical-binding: t; -*- + +;; Copyright (C) 2019, 2022 Free Software Foundation, Inc. + +;; Authors: Yoni Rabkin + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; if not, write to the Free Software Foundation, +;; Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; 2019-11-05 - This is a complete re-write of the emms-streams.el, +;; using a different approach. + +;; This includes the built-in list of streams which come with Emms by +;; default. Emms has no affiliation of any kind with the streaming +;; audio stations listed below, nor is this an endorsement of these +;; stations. Instead, this is a collection of stations submitted to +;; the project over the years by people who enjoy Emms. We hope you +;; will enjoy them too. + +;;; Code: + +(require 'emms) +(require 'emms-source-playlist) +(require 'emms-playlist-mode) +(require 'emms-cache) + + +;;; ------------------------------------------------------------------ +;;; definitions +;;; ------------------------------------------------------------------ + +(defvar emms-streams-buffer-name "Emms Streams" + "Name for creating a streams buffer.") + +(defvar emms-streams-built-in-disclaimer + ";; This includes the built-in list of streams which come with Emms by +;; default. Emms has no affiliation of any kind with the streaming +;; audio stations listed below, nor is this an endorsement of these +;; stations. Instead, this is a collection of stations submitted to +;; the project over the years by people who enjoy Emms. We hope you +;; will enjoy them too." + "Explaining the relationship between Emms and these streams.") + +(defvar emms-streams-built-in-list + '((*track* (type . streamlist) + (name . "http://www.somafm.com/beatblender.pls") + (metadata "SomaFM: Beatblender" "http://www.somafm.com/beatblender.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.somafm.com/secretagent.pls") + (metadata "SomaFM: Secret Agent" "http://www.somafm.com/secretagent.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.somafm.com/groovesalad.pls") + (metadata "SomaFM: Groove Salad" "http://www.somafm.com/groovesalad.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.somafm.com/dronezone.pls") + (metadata "SomaFM: Drone Zone" "http://www.somafm.com/dronezone.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.somafm.com/thetrip.pls") + (metadata "SomaFM: The Trip" "http://www.somafm.com/thetrip.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.somafm.com/indiepop.pls") + (metadata "SomaFM: Indie Pop Rocks" "http://www.somafm.com/indiepop.pls" 1 streamlist)) + (*track* (type . url) (name . "http://listen.radionomy.com:80/-PHILOSOMATIKAPROGRESSIVE-") + (metadata "P H I L O S O M A T I K A - Progressive Psytrance" "http://listen.radionomy.com:80/-PHILOSOMATIKAPROGRESSIVE-" 1 url)) + (*track* (type . streamlist) + (name . "http://www.bassdrive.com/BassDrive.m3u") + (metadata "Drum and Bass Radio, BassDrive" "http://www.bassdrive.com/BassDrive.m3u" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.ibiblio.org/wcpe/wcpe.pls") + (metadata "WCPE, Classical Music" "http://www.ibiblio.org/wcpe/wcpe.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://stream.nute.net/kohina/stream.ogg.m3u") + (metadata "Kohina - Old school game and demo music" "http://stream.nute.net/kohina/stream.ogg.m3u" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://privat.is-by.us:8000/necta192.mp3.m3u") + (metadata "Nectarine, Demoscene Radio, DE Continuum's relay 192 mp3" "http://privat.is-by.us:8000/necta192.mp3.m3u" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://nectarine.from-de.com/necta192.m3u") + (metadata "Nectarine, Demoscene Radio, DE stream (High Bitrate)" "http://nectarine.from-de.com/necta192.m3u" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://www.wfmu.org/wfmu.pls") + (metadata "WFMU, Freeform radio" "http://www.wfmu.org/wfmu.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://wfmu.org/wfmu_rock.pls") + (metadata "WFMU, Rock'n'Soul Ichiban!" "http://www.wfmu.org/wfmu.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://wfmu.org/wfmu_drummer.pls") + (metadata "WFMU, Give the Drummer Radio" "http://www.wfmu.org/wfmu.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://wfmu.org/wfmu_sheena.pls") + (metadata "WFMU, Sheena's Jungle Room" "http://www.wfmu.org/wfmu.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://nyc01.egihosting.com:6232/listen.pls") + (metadata "WBCR-LP - Berkshire Community Radio" "http://nyc01.egihosting.com:6232/listen.pls" 1 streamlist)) + (*track* (type . streamlist) + (name . "http://199.244.85.125:8000/wxhq1") + (metadata "WXHQ-LP - Newport Radio" "http://199.244.85.125:8000/wxhq1" 1 streamlist)))) + +(defcustom emms-streams-file (concat (file-name-as-directory emms-directory) + "streams.emms") + "A file used to store the built-in streams." + :group 'emms + :type 'file) + + +;;; ------------------------------------------------------------------ +;;; private functions +;;; ------------------------------------------------------------------ + +(defun emms-streams-install-file (file) + "Install FILE, containing streams." + (when (not (file-directory-p (file-name-directory emms-streams-file))) + (make-directory (file-name-directory emms-streams-file))) + (if (or (not (file-exists-p file)) + (and (file-exists-p file) + (y-or-n-p (format "overwrite existing %s?" file)))) + (progn + (message "writing %s" file) + (with-temp-buffer + (insert emms-source-playlist-native-header-line) + (insert (format "\n%s\n\n" emms-streams-built-in-disclaimer)) + (insert + (concat "(" + (mapconcat + #'(lambda (e) + (format "%S" e)) + emms-streams-built-in-list "\n") + ")")) + (write-region (point-min) (point-max) file)) + (message "writing %s... done" file)) + (message "aborting"))) + + +;;; ------------------------------------------------------------------ +;;; interface +;;; ------------------------------------------------------------------ + +(defun emms-streams-install () + "Install the built-in streams file." + (interactive) + (emms-streams-install-file emms-streams-file)) + +;;;###autoload +(defun emms-streams () + "Create or switch to the built-in streaming audio playlist." + (interactive) + (when (and (not (file-exists-p emms-streams-file)) + (y-or-n-p "Emms' built-in streams file hasn't been installed yet. Install it now?")) + (emms-streams-install)) + (let ((buf (get-buffer emms-streams-buffer-name))) + (when (not buf) + (with-current-buffer (get-buffer-create emms-streams-buffer-name) + (setq buf (current-buffer)) + (emms-playlist-mode) + (setq emms-playlist-buffer-p t) + (emms-playlist-set-playlist-buffer (current-buffer)) + (emms-add-native-playlist emms-streams-file))) + (switch-to-buffer buf))) + + +(provide 'emms-streams) + +;;; emms-streams.el ends here diff --git a/elisp/emms-tag-editor.el b/elisp/emms-tag-editor.el new file mode 100644 index 0000000..8c50df5 --- /dev/null +++ b/elisp/emms-tag-editor.el @@ -0,0 +1,908 @@ +;;; emms-tag-editor.el --- Edit track tags. -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2023 Free Software Foundation, Inc. +;; +;; Original Author: Ye Wenbin +;; Authors: the Emms developers (see AUTHORS file) + +;; This file is part of EMMS. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'emms-tag-editor) + +;;; Code: + +(condition-case nil + (require 'overlay) + (error nil)) +(require 'emms) +(eval-when-compile + (require 'emms-info-metaflac)) +(require 'emms-info-mp3info) +(require 'emms-playlist-mode) +(require 'emms-mark) +(require 'emms-cache) +(require 'emms-tag-tracktag) +(require 'format-spec) +(require 'subr-x) + +(defcustom emms-tag-editor-tag-ogg-program "vorbiscomment" + "*The name/path of the ogg editor program." + :type 'string + :group 'emms-tag-editor) + +(defvar emms-tag-editor-tags + '((info-artist . "a") + (info-albumartist . "A") + (info-composer . "C") + (info-performer . "p") + (info-title . "t") + (info-album . "l") + (info-tracknumber . "n") + (info-year . "y") + (info-genre . "g") + (info-date . "d") + (info-note . "c")) + "An alist to determine the format of various info tags.") + +(defvar emms-tag-editor-edit-buffer "*EMMS-TAGS*" + "Name of the buffer used for editing tags.") +(defvar emms-tag-editor-log-buffer "*EMMS-LOG*" + "Name of emms-tag-editor's log buffer.") + +(defun emms-tag-editor-make-format (tags) + "Make a format string based on TAGS." + (concat "%m\n" (emms-propertize (format "%-16s = " "name") + 'read-only t 'rear-nonsticky t + 'face 'bold) + "%f\n" + (mapconcat + (lambda (tag) + (concat (emms-propertize (format "%-16s = " (symbol-name tag)) + 'read-only t 'rear-nonsticky t + 'face 'bold) + "%" (cdr (assoc tag emms-tag-editor-tags)))) + tags "\n") + "\n\n")) + +(defvar emms-tag-editor-formats + (let* ((tags (mapcar #'car emms-tag-editor-tags)) + (default (emms-tag-editor-make-format (remove 'info-date tags)))) + `(("mp3" . ,default) + ("ogg" . ,(emms-tag-editor-make-format (remove 'info-year tags))) + ("flac" . ,(emms-tag-editor-make-format (remove 'info-year tags))) + ("opus" . ,(emms-tag-editor-make-format (remove 'info-genre tags))) + ("default" . ,default))) + "Format to use when inserting the track. +The CAR part is the extension of the track name, and the CDR part +is the format template. The format specification is like: + + m -- Track description + f -- Track name + a -- Track info-artist + C -- Track info-composer + p -- Track info-performer + t -- Track info-title + l -- Track info-album + n -- Track info-tracknumber + D -- Track info-discnumber + y -- Track info-year + g -- Track info-genre + ; -- Track info-note + +You can add new specifications in `emms-tag-editor-tags', and use +`emms-tag-editor-make-format' to create a new format string. + +The CDR part also can be a function, which accepts one parameter, +the track, and returns a string to insert in +`emms-tag-editor-edit-buffer'.") + +(defvar emms-tag-editor-get-format-function 'emms-tag-editor-get-format + "Determines which function to call to get the format string, which is +used for inserting the track.") + +(defvar emms-tag-editor-parse-function 'emms-tag-editor-default-parser + "Function to parse tags in `emms-tag-editor-edit-buffer\\='. +It should find all modified tags, and return all the tracks. The +tracks for which a tag has been modified should set a property +\\='tag-modified to t. If the track name has been changed, the +function should set a new property \\='newname instead of setting +the \\='name directly. + +See also `emms-tag-editor-default-parser\\='.") + +(defvar emms-tag-editor-tagfile-functions + '(("mp3" "mid3v2" + ((info-artist . "-a") + (info-title . "-t") + (info-album . "-A") + (info-tracknumber . "-T") + (info-year . "-y") + (info-genre . "-g") + (info-note . "-c") + (info-albumartist . "--TPE2") + (info-composer . "--TCOM") + (info-performer . "--TOPE") + (info-date . "--TDAT"))) + ("ogg" . emms-tag-editor-tag-ogg) + ("flac" . emms-tag-editor-tag-flac) + ("opus" . emms-tag-tracktag-file)) + "An alist used when committing changes to tags in files. +If the external program sets tags by command line options +one-by-one, then the list should like: + (EXTENSION PROGRAM COMMAND_LINE_OPTIONS) + +Otherwise, a function that accepts a single parameter, the track, +should be given. + +See also `emms-tag-editor-tag-file' and `emms-tag-editor-tag-ogg'.") + +(defun emms-tag-editor-tag-flac (track) + "Commit changes to an FLAC file according to TRACK." + (require 'emms-info-metaflac) + (with-temp-buffer + (let ((tags '("artist" "composer" "performer" "title" "album" "tracknumber" "discnumber" "date" "genre" "note")) + val) + (mapc (lambda (tag) + (let ((info-tag (intern (concat "info-" tag)))) + (when (> (length (setq val (emms-track-get track info-tag))) 0) + (insert (upcase tag) "=" val "\n")))) + tags) + (when (buffer-string) + (apply #'call-process-region (point-min) (point-max) + emms-info-metaflac-program-name nil + (get-buffer-create emms-tag-editor-log-buffer) + nil + (append + (mapcar (lambda (tag) + (concat "--remove-tag=" tag)) + tags) + '("--import-tags-from=-") + '("--") + (list (emms-track-name track)))))))) + +(defun emms-tag-editor-tag-ogg (track) + "Commit changes to an OGG file according to TRACK." + (let (args val) + (mapc (lambda (tag) + (let ((info-tag (intern (concat "info-" tag)))) + (when (> (length (setq val (emms-track-get track info-tag))) 0) + (setq args (append (list "-t" (concat (upcase tag) "=" val)) args))))) + '("artist" "composer" "performer" "title" "album" "tracknumber" "date" "genre" "note")) + (when args + (apply #'call-process emms-tag-editor-tag-ogg-program nil + (get-buffer-create emms-tag-editor-log-buffer) + nil + "-w" + (append args (list (emms-track-name track))))))) + +(defun emms-tag-editor-tag-file (track program tags filename) + "Change TAGS in FILE, using PROGRAM. +Valid tags are given by `emms-tag-editor-tagfile-functions'." + (let (args val) + (mapc (lambda (tag) + (unless (or (string-prefix-p "-" (cdr tag)) + (string-prefix-p "+" (cdr tag)) + (string-prefix-p "/" (cdr tag))) + (error "Command arguments need prefix in `emms-tag-editor-tagfile-functions'.")) + (setq val (emms-track-get track (car tag))) + (if (and val (stringp val)) + (setq args (append (list (cdr tag) val) args)))) + tags) + (apply #'call-process program + nil (get-buffer-create emms-tag-editor-log-buffer) nil + (nconc args (list filename))))) + +(defun emms-tag-editor-get-format (track) + "Get the format string to use for committing changes to TRACK." + (let ((format + (assoc (file-name-extension (emms-track-name track)) + emms-tag-editor-formats))) + (if format + (cdr format) + (cdr (assoc "default" emms-tag-editor-formats))))) + +(defun emms-tag-editor-format-track (track) + "Return a string representing the info tags contained in TRACK. +This string is suitable for inserting into the tags buffer." + (let ((format (funcall emms-tag-editor-get-format-function track))) + (if (functionp format) + (funcall format track) + (format-spec + format + (apply #'format-spec-make + ?m (emms-propertize (emms-track-force-description track) + 'face 'emms-playlist-track-face + 'emms-track (copy-sequence track)) + ?f (emms-track-name track) + (apply #'append + (mapcar (lambda (tag) + (list (string-to-char (cdr tag)) + (or (emms-track-get track (car tag)) ""))) + emms-tag-editor-tags))))))) + +(defun emms-tag-editor-track-at (&optional pos) + "Return a copy of the track at POS. Defaults to point if POS is nil." + (let ((track (emms-playlist-track-at pos)) + newtrack) + (when track + (setq newtrack (copy-sequence track)) + (emms-track-set newtrack 'position (point-marker)) + (emms-track-set newtrack 'orig-track track) + newtrack))) + +(defsubst emms-tag-editor-erase-buffer (&optional buf) + "Erase the buffer BUF, and ensure that it exists." + (let ((inhibit-read-only t)) + (with-current-buffer (get-buffer-create buf) + (erase-buffer)))) + +(defsubst emms-tag-editor-insert-track (track) + "Insert TRACK, if it is specified." + (and track + (insert (emms-tag-editor-format-track track)))) + +(defsubst emms-tag-editor-display-log-buffer-maybe () + "Display the log buffer if it has any contents." + (if (> (buffer-size (get-buffer emms-tag-editor-log-buffer)) 0) + (display-buffer emms-tag-editor-log-buffer))) + +(defun emms-tag-editor-insert-tracks (tracks) + "Insert TRACKS into the tag editor buffer." + (save-excursion + (emms-tag-editor-erase-buffer emms-tag-editor-log-buffer) + (emms-tag-editor-erase-buffer emms-tag-editor-edit-buffer) + (set-buffer (get-buffer emms-tag-editor-edit-buffer)) + (mapc #'emms-tag-editor-insert-track tracks) + (emms-tag-editor-mode) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (emms-tag-editor-display-log-buffer-maybe))) + +(defun emms-tag-editor--tagfile-function (track) + "Return value of `emms-tag-editor-tagfile-functions' for TRACK, or nil." + (assoc (file-name-extension (emms-track-get track 'name)) + emms-tag-editor-tagfile-functions)) + +(defun emms-tag-editor--track-editable-p (track) + "Return t if TRACK is not a file, or has a tagfile function defined." + (or (not (emms-track-file-p track)) + (emms-tag-editor--tagfile-function track))) + +(defun emms-tag-editor-edit-track (track &optional edit-anyway) + "Edit the track at point, or TRACK. +If EDIT-ANYWAY is true or TRACK is not a file type, it will be loaded +in the tag editor. Otherwise, if EMMS does not have a program configured +to actually write tags to the audio file, do not open the tag data in +the editor." + (interactive (list (emms-tag-editor-track-at))) + (cond + ((null track) (message "No track at point!")) + ((or (emms-tag-editor--track-editable-p track) edit-anyway) + (emms-tag-editor-insert-tracks (list track))) + (t (message "EMMS has no tag writing program configured for this file type!")))) + +(defun emms-tag-editor-edit-marked-tracks (&optional edit-anyway) + "Edit all tracks marked in the current buffer. +If EDIT-ANYWAY is nil, filter out any file tracks that do not have a +tagfile function defined." + (interactive) + (let* ((tracks (emms-mark-mapcar-marked-track 'emms-tag-editor-track-at t)) + (funcs (mapcar #'emms-tag-editor--tagfile-function tracks))) + (when (seq-some #'null funcs) + (unless edit-anyway + (setq tracks (seq-filter #'emms-tag-editor--track-editable-p tracks)) + (message "Skipped file tracks without a tag writing program configured."))) + (if (null tracks) + (message "No writable track marked!") + (emms-tag-editor-insert-tracks tracks)))) + +(defun emms-tag-editor-edit (&optional arg) + "Edit tags of either the track at point or all marked tracks. +With a prefix argument, edits tags even if there is no external +program for writing tags to the specified track or tracks." + (interactive "P") + (if (emms-mark-has-markedp) + (emms-tag-editor-edit-marked-tracks arg) + (emms-tag-editor-edit-track (emms-tag-editor-track-at) arg))) + +(defvar emms-tag-editor-mode-map + (let ((map (make-sparse-keymap))) + ;; FIXME: Bind to "\t" rather than [tab] so it works in ttys as well. + (define-key map [tab] #'emms-tag-editor-next-field) + (define-key map [backtab] #'emms-tag-editor-prev-field) + (define-key map "\C-c\C-n" #'emms-tag-editor-next-track) + (define-key map "\C-c\C-p" #'emms-tag-editor-prev-track) + (define-key map "\C-c\C-c" #'emms-tag-editor-submit-and-exit) + (define-key map "\C-c\C-s" #'emms-tag-editor-submit) + (define-key map "\C-x\C-s" #'emms-tag-editor-submit) + (define-key map "\C-c\C-r" #'emms-tag-editor-set-all) + (define-key map "\C-c\C-a" #'emms-tag-editor-replace-in-tag) + (define-key map "\C-c\C-t" #'emms-tag-editor-transpose-tag) + map) + "Keymap for `emms-tag-editor-mode'.") +(define-key emms-playlist-mode-map "E" #'emms-tag-editor-edit) + +(define-derived-mode emms-tag-editor-mode text-mode "Tag-Edit" + "Major mode to edit track tags. +\\{emms-tag-editor-mode-map}") + +(defun emms-tag-editor-set-all (tag value) + "Set TAG to VALUE in all tracks. +If transient-mark-mode is turned on, you can apply the command to +a selected region. + + If `transient-mark-mode' is on and the mark is active, the +changes will only take effect on the tracks in the region." + (interactive + (list (emms-completing-read "Set tag: " + (mapcar (lambda (arg) + (list (symbol-name (car arg)))) + emms-tag-editor-tags) + nil t) + (read-from-minibuffer "To: "))) + (save-excursion + (save-restriction + (if (and mark-active transient-mark-mode) + (narrow-to-region (region-beginning) (region-end))) + (goto-char (point-min)) + (while (re-search-forward (concat "^" (regexp-quote tag) "[ \t]+=[ \t]+") nil t) + (delete-region (point) (line-end-position)) + (insert value))))) + +(defun emms-tag-editor-replace-in-tag (tag from to) + "Query and replace text in selected TAG. +For example, if the info-title tag is selected, then only perform +replacement in title tags. + +If `transient-mark-mode' is on and the mark is active, the +changes will only take effect on the tracks in the region." + (interactive + (cons (emms-completing-read "Replace in tag: " + (mapcar (lambda (arg) + (list (symbol-name (car arg)))) + emms-tag-editor-tags) + nil t) + (let ((common (query-replace-read-args + (if (and transient-mark-mode mark-active) + "Query replace regexp in region" + "Query replace regexp") + t))) + (butlast common 2)))) + (let ((overlay (make-overlay (point-min) (1+ (point-min))))) + (overlay-put overlay 'face 'match) + (unwind-protect + (save-excursion + (save-restriction + (when (and mark-active transient-mark-mode) + (narrow-to-region (region-beginning) (region-end)) + (deactivate-mark)) + (setq tag (concat (regexp-quote tag) "[ \t]+=[ \t]+")) + (goto-char (point-min)) + (map-y-or-n-p + (lambda (match) + (move-overlay overlay (match-beginning 0) (match-end 0)) + (format "Replace %s to %s" (car match) (cadr match))) + (lambda (match) + (delete-region (- (point) (length (car match))) (point)) + (insert (cadr match))) + (lambda () + (if (and (save-excursion + (re-search-backward tag (line-beginning-position) t)) + (not (= (point) (line-end-position))) + (re-search-forward from (line-end-position) t)) + (list (match-string 0) (cond + ((and (listp to) + (fboundp (car to)) (funcall (car to) (cdr to) 0))) + ((string-match-p "\\\\[&[:digit:]]" to) + (match-substitute-replacement to nil nil)) + ((stringp to) to) + (t (error "Wrong type argument: string or cons cell, %s" to)))) + (let (found) + (while (and (not found) + (re-search-forward tag nil t)) + (if (re-search-forward from (line-end-position) t) + (setq found t))) + (and found (list (match-string 0) (cond + ((and (listp to) + (fboundp (car to)) (funcall (car to) (cdr to) 0))) + ((string-match-p "\\\\[&[:digit:]]" to) + (match-substitute-replacement to nil nil)) + ((stringp to) to) + (t (error "Wrong type argument: string or cons cell, %s" to))))))))))) + (delete-overlay overlay)))) + +(defun emms-tag-editor-transpose-tag (tag1 tag2) + "Transpose value of TAG1 and TAG2. +If `transient-mark-mode' is on and the mark is active, the +changes will only take effect on the tracks in the region." + (interactive + (let* ((tag1 (intern (emms-completing-read + "Tag 1: " + (mapcar (lambda (arg) + (list (symbol-name (car arg)))) + emms-tag-editor-tags) + nil t))) + (tag2 (intern (emms-completing-read + "Tag 2: " + (mapcar (lambda (arg) + (list (symbol-name (car arg)))) + (assq-delete-all + tag1 + (copy-sequence emms-tag-editor-tags))) + nil t)))) + (list tag1 tag2))) + (save-excursion + (save-restriction + (if (and mark-active transient-mark-mode) + (narrow-to-region (region-beginning) (region-end))) + (let* ((emms-playlist-buffer-p t) + (tracks (emms-playlist-tracks-in-region (point-min) + (point-max))) + (inhibit-read-only t) + temp) + (erase-buffer) + (dolist (track (nreverse tracks)) + (setq temp (emms-track-get track tag1)) + (emms-track-set track tag1 (emms-track-get track tag2)) + (emms-track-set track tag2 temp) + (emms-track-set track 'tag-modified t) + (emms-tag-editor-insert-track track)))))) + +(defun emms-tag-editor-guess-tag-filename (pattern fullname) + "A pattern is a string like \"%a-%t-%y\" which stand for +the file name is constructed by artist, title, year with seperator '-'. +see `emms-tag-editor-compile-pattern' for detail about pattern syntax. +Available tags are list in `emms-tag-editor-tags'. + +if with prefix argument, the information will extract from full +name, otherwise just match in file name. + +An example to guess tag from file name, which the file directory is +the aritist and file name is the title. It can be done like: +C-u M-x emms-tag-editor-guess-tag-filename RET +%{a:[^/]+}/%{t:[^/]+}\.mp3 RET +" + (interactive + (list + (read-from-minibuffer (format "Match in %sfile name(C-h for help): " + (if current-prefix-arg "FULL " "")) + nil + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-h" + (lambda () + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ + "A pattern is a string like \"%a-%t-%y\" which stand for +the file name is constructed by artist, title, year with seperator '-'. +see `emms-tag-editor-compile-pattern' for detail about pattern syntax. + +Available tags are: +") + (mapc (lambda (tag) + (princ (format "\t%s - %S\n" (cdr tag) (car tag)))) + emms-tag-editor-tags) + (with-current-buffer standard-output + (help-mode))))) + map)) + current-prefix-arg)) + (setq pattern (emms-tag-editor-compile-pattern pattern)) + (save-excursion + (save-restriction + (if (and mark-active transient-mark-mode) + (narrow-to-region (region-beginning) (region-end))) + (let* ((emms-playlist-buffer-p t) + (tracks (emms-playlist-tracks-in-region (point-min) + (point-max))) + (inhibit-read-only t) + filename) + (erase-buffer) + (dolist (track (nreverse tracks)) + (emms-track-set track 'tag-modified t) + (setq filename (emms-track-name track)) + (or fullname (setq filename (file-name-nondirectory filename))) + (when (string-match (car pattern) filename) + (mapc (lambda (pair) + (emms-track-set + track + (car (rassoc (char-to-string (car pair)) + emms-tag-editor-tags)) + (match-string (cdr pair) filename))) + (cdr pattern))) + (emms-tag-editor-insert-track track)))))) + +(defun emms-tag-editor-compile-pattern (pattern) + "A pattern to regexp convertor. \"%a-%{b:[a-z]+}\" will compile to +\"\\([^-]+\\)-\\([a-z]+\\)\"." + (let ((index 0) + (paren 0) + (i 0) + (len (length pattern)) + (compiled "") + registers register match + escape c) + (while (< i len) + (setq c (aref pattern i) + i (1+ i)) + (cond ((= c ?\\) + (setq c (aref pattern i) + i (1+ i)) + (cond ((= c ?\() + (setq paren (1+ paren) + index (1+ index))) + ((= c ?\)) + (setq paren (1- paren)))) + (setq compiled (concat compiled "\\" (char-to-string c)))) + ((= c ?%) + (setq c (aref pattern i) + i (1+ i)) + ;; How to repressent } in the pattern? + (if (= c ?{) + (if (/= (aref pattern (1+ i)) ?:) + (error "Compile error") + (setq register (aref pattern i) + match "" + i (+ i 2)) + (while (and (< i len) + (or escape (/= (aref pattern i) ?}))) + (if escape + (setq escape nil) + (if (= (aref pattern i) ?\\) + (setq escape t))) + (setq match (concat match (char-to-string (aref pattern i))) + i (1+ i))) + (setq i (1+ i))) + (setq register c + match "[^-]+")) + (setq compiled (concat compiled "\\(" match "\\)") + index (1+ index)) + (push (cons register index) registers)) + (t (setq compiled (concat compiled (char-to-string c)))))) + (if (/= paren 0) (error "Paren not match!")) + (cons compiled registers))) + +(defun emms-tag-editor-next-field (arg) + "Move to the next tag field." + (interactive "p") + (if (> arg 0) + (re-search-forward "\\s-*=[ \t]*" nil nil arg) + (emms-tag-editor-prev-field (- arg)))) + +(defun emms-tag-editor-prev-field (arg) + "Move to the previous tag field." + (interactive "p") + (if (< arg 0) + (emms-tag-editor-next-field (- arg)) + (skip-chars-backward " \t=") + (re-search-backward "\\s-*=[ \t]*" nil nil arg) + (skip-chars-forward " \t="))) + +(defun emms-tag-editor-prev-track () + "Move to the previous track." + (interactive) + (let ((prev (previous-single-property-change (point) + 'emms-track))) + (when (not prev) + (error "No previous track")) + (when (not (get-text-property prev 'emms-track)) + (setq prev (or (previous-single-property-change prev 'emms-track) + (point-min)))) + (when (or (not prev) + (not (get-text-property prev 'emms-track))) + (error "No previous track")) + (goto-char prev))) + +(defun emms-tag-editor-next-track () + "Move to the next track." + (interactive) + (let ((next (next-single-property-change (point) + 'emms-track))) + (when (not next) + (error "No next track")) + (when (not (get-text-property next 'emms-track)) + (setq next (next-single-property-change next 'emms-track))) + (when (or (not next) + (= next (point-max))) + (error "No next track")) + (goto-char next))) + +(defun emms-tag-editor-submit (arg) + "Make modified tags take affect. +With prefix argument, bury the tag edit buffer." + (interactive "P") + (let ((tracks (funcall emms-tag-editor-parse-function))) + (if (not (and tracks (y-or-n-p "Submit changes? "))) + (message "No tags were modified") + (emms-tag-editor-erase-buffer emms-tag-editor-log-buffer) + (emms-tag-editor-apply tracks) + (emms-cache-save))) + (when arg (bury-buffer))) + +(defun emms-tag-editor-apply (tracks) + "Apply all changes made to TRACKS." + (message "Setting tags...") + (let (filename func exit old pos val need-sync) + (save-excursion + (dolist (track tracks) + (when (emms-track-get track 'tag-modified) + (setq filename (emms-track-name track) + old (emms-track-get track 'orig-track)) + ;; rename local file + (when (and (emms-track-get track 'newname) + (emms-track-file-p track) + (file-writable-p (emms-track-name track)) + (y-or-n-p (format "Rename %s to %s? " + (emms-track-name track) + (emms-track-get track 'newname)))) + (setq filename (emms-track-get track 'newname)) + (ignore-errors + ;; if `emms-tag-editor-rename-format' is like "%a/%l/%t", + ;; we may need to create directory first. + (let ((dir (file-name-directory filename))) + (when dir (make-directory dir t))) + ;; Ignore errors so that renaming multiple files doesn't stop + ;; because of one that fails. In that case it's probably + ;; old-file = newfile which causes the problem. + (rename-file (emms-track-name track) filename 1)) + (emms-track-set old 'name filename) + ;; for re-enter this function + (emms-track-set track 'name filename) + (setq need-sync t) + ;; register to emms-cache-db + (when (functionp emms-cache-modified-function) + (funcall emms-cache-modified-function) + (funcall emms-cache-set-function 'file filename old))) + (emms-track-set track 'newname nil) + ;; set tags to original track + (dolist (tag emms-tag-editor-tags) + (when (setq val (emms-track-get track (car tag))) + (emms-track-set old (car tag) val))) + ;; use external program to change tags in the file + (when (and (emms-track-file-p track) + (file-writable-p (emms-track-name track)) + (setq func (emms-tag-editor--tagfile-function track))) + (setq exit + (if (functionp (cdr func)) + (funcall (cdr func) track) + (emms-tag-editor-tag-file track (cadr func) (nth 2 func) filename))) + (if (zerop exit) + (emms-track-get track 'info-mtime (butlast (current-time))) + (emms-tag-editor-log + "Changing tags of %s failed with exit value %d" + filename exit))) + ;; update track in playlist + (when (and (setq pos (emms-track-get track 'position)) + (marker-position pos)) + (set-buffer (marker-buffer pos)) + (goto-char pos) + (funcall emms-playlist-update-track-function)) + ;; clear modified tag + (emms-track-set track 'tag-modified nil)))) + ;; sync the cache + (when need-sync + (emms-cache-sync nil)) + (unless (emms-tag-editor-display-log-buffer-maybe) + (message "Setting tags...done")))) + +(defun emms-tag-editor-submit-and-exit () + "Submit changes to track information and exit the tag editor." + (interactive) + (emms-tag-editor-submit t)) + +(defun emms-tag-editor-default-parser () + "Default function used to parse tags in `emms-tag-editor-edit-buffer'." + (let (next tracks track key val) + (goto-char (point-min)) + (if (get-text-property (point) 'emms-track) + (setq next (point)) + (setq next (next-single-property-change (point) + 'emms-track))) + (when next + (while + (progn + (goto-char next) + (setq track (get-text-property (point) 'emms-track)) + (forward-line 1) + (mapc (lambda (pair) + (when (string-match "\\s-*=\\s-*" pair) + (setq key (intern-soft (substring pair 0 (match-beginning 0))) + val (substring pair (match-end 0))) + (when (and key + (let ((old (emms-track-get track key))) + (if old + (not (string= val old)) + (string< "" val)))) + (if (eq key 'name) + (emms-track-set track 'newname val) + (emms-track-set track key val)) + (emms-track-set track 'tag-modified t)))) + (let ((end-point (next-single-property-change + (point) 'emms-track))) + (if (and end-point (save-excursion + (goto-char end-point) + (bolp))) + (setq next end-point) + (progn + (setq next nil + end-point (point-max)))) + (split-string (buffer-substring (point) end-point) + "\n"))) + (if (emms-track-get track 'tag-modified) + (push track tracks)) + next)) + tracks))) + +(defun emms-tag-editor-log (&rest args) + (with-current-buffer (get-buffer-create emms-tag-editor-log-buffer) + (goto-char (point-max)) + (insert (apply #'format args) "\n"))) + +;; +;; Renaming files according their tags +;; + +(defvar emms-tag-editor-rename-format "%a - %l - %n - %t" + "When `emms-tag-editor-rename' is invoked the track's file will +be renamed according this format specification. The file +extension will be added automatically. + +It uses the format specs defined in `emms-tag-editor-tags'.") + +(defun emms-tag-editor-rename () + "Rename the file corresponding to track at point or all marked +tracks according to the value of +`emms-tag-editor-rename-format'." + (interactive) + (if (emms-mark-has-markedp) + (emms-tag-editor-rename-marked-tracks) + (emms-tag-editor-rename-track (emms-tag-editor-track-at)))) + +(defun emms-tag-editor-rename-track (track &optional dont-apply) + "Rename TRACK's file according `emms-tag-editor-rename-format's +value. + +If DONT-APPLY is non-nil the changes won't be applied directly. +Then it's the callers job to apply them afterwards with +`emms-tag-editor-apply'." + (if (emms-track-file-p track) + (let* ((old-file (emms-track-name track)) + (path (file-name-directory old-file)) + (suffix (file-name-extension old-file)) + (new-file (concat + path + (format-spec + emms-tag-editor-rename-format + (apply #'format-spec-make + (apply #'append + (mapcar + (lambda (tag) + (list (string-to-char (cdr tag)) + (or (emms-track-get track (car tag)) + ""))) + emms-tag-editor-tags)))) + "." suffix))) + (emms-track-set track 'newname new-file) + (emms-track-set track 'tag-modified t) + (unless dont-apply + (emms-tag-editor-apply (list track)))) + (message "Only files can be renamed."))) + +(defun emms-tag-editor-rename-marked-tracks () + "Rename the files corresponding to all marked tracks according +`emms-tag-editor-rename-format's value." + (let ((tracks (emms-mark-mapcar-marked-track + 'emms-tag-editor-track-at t))) + (if (null tracks) + (message "No track marked!") + (dolist (track tracks) + (emms-tag-editor-rename-track track t)) + (emms-tag-editor-apply tracks)))) + +(define-key emms-playlist-mode-map "R" #'emms-tag-editor-rename) + +(defvar emms-tag-editor-pipe-config + '(("mid3iconv -e gbk " + :command "mid3iconv" + :arguments ("-e" "gbk" name))) + "Config of tag editor pipe. + +A pipe is defined like below: + + (\"piper-name\" :command xxx :arguments xxx) + +:command is a command string, this command can not change file name. +:arguments is a list or a function return list, for example: + + (\"--track-name\" name (\"--year\" info-year)) + (lambda (track) (list (emms-track-name track \\='name))) + +1. symbols can be \\='name or elements of (mapcar \\='car emms-tag-editor-tags), + which will be replaced to track info before run command. +2. sublist used to deal with group args, for example, (\"--year\" info-year), when + track\\='s info-year is nil, the \"--year\" will be removed too.") + +(defun emms-tag-editor-pipe-get (pipe-name key) + "Get the pipe value of KEY named PIPE-NAME in `emms-tag-editor-pipe-config\\='." + (let ((config emms-tag-editor-pipe-config)) + (plist-get (cdr (assoc pipe-name config)) key))) + +(defun emms-tag-editor-pipe () + "Select and run pipe command to track at point or all marked tracks." + (interactive) + (let* ((pipe-name (completing-read "Please choose pipe: " emms-tag-editor-pipe-config))) + (when pipe-name + (if (emms-mark-has-markedp) + (emms-tag-editor-marked-track-pipe pipe-name) + (emms-tag-editor-track-pipe + (emms-tag-editor-track-at) pipe-name))))) + +(defun emms-tag-editor-track-pipe (track pipe-name) + "Run command of pipe nameed PIPE-NAME to TRACK." + (if (emms-track-file-p track) + (let* ((coding-system-for-read 'utf-8) + (command (emms-tag-editor-pipe-get pipe-name :command)) + (arguments (emms-tag-editor-pipe-get pipe-name :arguments))) + (when (functionp arguments) + (setq arguments (funcall arguments track))) + (setq arguments + (when (listp arguments) + (mapcar + #'(lambda (x) + (cond ((symbolp x) + (emms-track-get track x)) + ((listp x) + (let ((list (mapcar + #'(lambda (y) + (if (symbolp y) + (emms-track-get track y) + y)) + x))) + (if (member nil list) + (list nil) + list))) + (t x))) + arguments))) + (setq arguments + (flatten-tree + (remove (list nil) arguments))) + (if (and command (listp arguments)) + (if (member nil arguments) + (message "Warn: skip run %S" (string-join `(,command ,@(remove nil arguments)) " ")) + (if (zerop (apply #'call-process + command nil nil nil arguments)) + (progn + (message "Run command: %S" (string-join `(,command ,@arguments) " ")) + (run-hook-with-args 'emms-info-functions track)) + (message "Fail to run command: %S" (string-join `(,command ,@arguments) " ")))) + (message "No command or arguments are found."))) + (message "Only support files."))) + +(defun emms-tag-editor-marked-track-pipe (pipe-name) + "Run command of pipe named PIPE-NAME to marked tracks." + (let ((tracks (emms-mark-mapcar-marked-track + 'emms-tag-editor-track-at t))) + (if (null tracks) + (message "No track marked!") + (dolist (track tracks) + (emms-tag-editor-track-pipe track pipe-name))))) + +(provide 'emms-tag-editor) +;;; Emms-tag-editor.el ends here diff --git a/elisp/emms-tag-tracktag.el b/elisp/emms-tag-tracktag.el new file mode 100644 index 0000000..4ffabb0 --- /dev/null +++ b/elisp/emms-tag-tracktag.el @@ -0,0 +1,77 @@ +;;; emms-tag-tracktag.el --- EMMS interface for audiotools tracktag -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Grant Shoshin Shangreaux +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Provides a wrapper for audiotools tracktag executable +;; http://audiotools.sourceforge.net/tracktag.html +;; Given an EMMS TRACK structure, it will map the emms-info fields onto +;; arguments for tracktag. Then it calls the tracktag process to write the +;; info as metadata tags on the track's associated file. + +;;; Code: + +(require 'emms) + +(defvar emms-tag-tracktag--info-fields + '((info-artist . artist) + (info-composer . composer) + (info-performer . performer) + (info-title . name) + (info-album . album) + (info-tracknumber . number) + (info-discnumber . album-number) + (info-year . year) + (info-date . date) + (info-note . comment)) + "An alist mapping info-* fields to tracktag fields.") + +(defvar emms-tag-tracktag-log-buffer "*EMMS-LOG*" + "Name of emms-tag-tracktag's log buffer. +Defaults to the same value as emms-tag-editor-log-buffer") + +(defun emms-tag-tracktag--map-track-info (track) + (seq-filter (lambda (cell) (cdr cell)) + (mapcar (lambda (pair) + (cons (cdr pair) (emms-track-get track (car pair)))) + emms-tag-tracktag--info-fields))) + +(defun emms-tag-tracktag--build-args (track) + (flatten-list + (append + (mapcar (lambda (pair) + (let ((tag (car pair)) (value (cdr pair))) + (when value + ;; if we've deleted a tag value in the editor, remove the tag from file metadata. + (if (string-equal "" value) (concat "--remove-" (format "%s" tag)) + (concat "--" (format "%s" tag) "=" value))))) + (emms-tag-tracktag--map-track-info track)) + (list (emms-track-name track))))) + +(defun emms-tag-tracktag-file (track) + (apply #'call-process + "tracktag" nil + (get-buffer-create emms-tag-tracktag-log-buffer) + nil + "-Vdebug" + (emms-tag-tracktag--build-args track))) + +(provide 'emms-tag-tracktag) +;;; emms-tag-tracktag.el ends here diff --git a/elisp/emms-url.el b/elisp/emms-url.el new file mode 100644 index 0000000..4e05d7a --- /dev/null +++ b/elisp/emms-url.el @@ -0,0 +1,114 @@ +;;; emms-url.el --- Make URL and EMMS work together well -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; These routines sanify input to URL and parse data returned by URL. + +;;; Code: + +(require 'url) +(require 'emms-compat) + +(defvar emms-url-specials-entire + '((?\ . "%20") + (?\n . "%0D%0A")) + "*An alist of characters which must be represented specially in URLs. +The transformation is the key of the pair. + +This is used by `emms-url-quote-entire'.") + +(defun emms-url-quote-entire (url) + "Escape specials conservatively in an entire URL. + +The specials to escape are specified by the `emms-url-specials-entire' +variable. + +If you want to escape parts of URLs thoroughly, then use +`emms-url-quote' instead." + (apply (function concat) + (mapcar + (lambda (ch) + (let ((repl (assoc ch emms-url-specials-entire))) + (if (null repl) + (char-to-string ch) + (cdr repl)))) + (append url nil)))) + +(defun emms-url-quote (s &optional safe) + "Replace special characters in S using the `%xx' escape. +This is useful for escaping parts of URLs, but not entire URLs. + +Characters in [a-zA-Z_.-/] and SAFE(default is \"\") will never be +quoted. +e.g., + (emms-url-quote \"abc def\") => \"abc%20def\"." + (if (not (stringp s)) + "" + (or safe (setq safe "")) + (save-match-data + (let ((re (if (string-match "]" safe) + ;; `]' should be placed at the beginning inside [] + (format "[]a-zA-Z_.-/%s]" + (emms-replace-regexp-in-string "]" "" safe)) + (format "[a-zA-Z_.-/%s]" safe)))) + (mapconcat + (lambda (c) + (let ((s1 (char-to-string c))) + (if (string-match re s1) + s1 + (format "%%%02x" c)))) + (string-to-list (encode-coding-string s 'utf-8)) + ""))))) + +(defun emms-url-quote-plus (s &optional safe) + "Run (emms-url-quote s \" \"), then replace ` ' with `+'." + (emms-replace-regexp-in-string + " " "+" (emms-url-quote s (concat safe " ")))) + +(defun emms-url-quote-underscore (s &optional safe) + "Run (emms-url-quote s \" \"), then replace ` ' with `_'." + (emms-replace-regexp-in-string + " " "_" (emms-url-quote s (concat safe " ")))) + +(defun emms-http-content-coding () + (save-match-data + (and (boundp 'url-http-content-type) + (stringp url-http-content-type) + (string-match ";\\s-*charset=\\([^;[:space:]]+\\)" + url-http-content-type) + (intern-soft (downcase (match-string 1 url-http-content-type)))))) + +(defun emms-http-decode-buffer (&optional buffer) + "Recode the buffer with `url-retrieve's contents. Else the +buffer would contain multibyte chars like \\123\\456." + (with-current-buffer (or buffer (current-buffer)) + (let* ((default (or (car default-process-coding-system) 'utf-8)) + (coding (or (emms-http-content-coding) default))) + (when coding + ;; (pop-to-buffer (current-buffer)) + ;; (message "content-type: %s" url-http-content-type) + ;; (message "coding: %S [default: %S]" coding default) + (set-buffer-multibyte t) + (decode-coding-region (point-min) (point-max) coding))))) + +(provide 'emms-url) +;;; emms-url.el ends here diff --git a/elisp/emms-volume-amixer.el b/elisp/emms-volume-amixer.el new file mode 100644 index 0000000..9cde1a9 --- /dev/null +++ b/elisp/emms-volume-amixer.el @@ -0,0 +1,94 @@ +;;; emms-volume-amixer.el --- a mode for changing volume using amixer -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009, 2023 Free Software Foundation, Inc. + +;; Author: Martin Schoenmakers + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file defines a few simple functions to raise or lower the volume +;; using amixer. It can be used stand-alone, though it's meant for usage +;; with EMMS, particularly with emms-volume.el + +;;; History: + +;; May 30 2006: First cleanup and collation of amixer functions into a +;; separate file for releasability. + + +;;; Code: +(defcustom emms-volume-amixer-control "Master" + "The control to change the volume with. +Controls includes \"Master\", \"PCM\", etc. For a full list of available +controls, run `amixer controls' in a shell." + :type '(choice (const :tag "Master" "Master") + (const :tag "PCM" "PCM") + (string :tag "Something else: ")) + :group 'emms-volume) + +(defcustom emms-volume-amixer-card 0 + "The card number to change volume. +The card is identified by a number. For a full list run `cat +/proc/asound/cards' in a shell." + :type 'integer + :group 'emms-volume) + +(defvar emms-volume-amixer-volume-regexp + "\\[\\([0-9]+\\)%\\]" + "Regexp to capture the volume from amixer output.") + +;;;###autoload +(defun emms-volume-amixer-change (amount) + "Change amixer master volume by AMOUNT." + (message "Playback channels: %s" + (with-temp-buffer + (when (zerop + (call-process "amixer" nil (current-buffer) nil + "-c" + (format "%d" emms-volume-amixer-card) + "sset" emms-volume-amixer-control + (format "%d%%%s" (abs amount) + (if (< amount 0) "-" "+")))) + (if (re-search-backward emms-volume-amixer-volume-regexp nil t) + (match-string 1)))))) + +(defun emms-volume-amixer-get () + "Return the amixer volume. + +Number is limited to the range [0-100]." + (let ((v (with-temp-buffer + (when (zerop + (call-process "amixer" nil (current-buffer) nil + "-c" + (format "%d" emms-volume-amixer-card) + "sget" emms-volume-amixer-control)) + (if (re-search-backward + emms-volume-amixer-volume-regexp nil t) + (match-string 1) + nil))))) + (if v + (max (min (string-to-number v) 100) 0) + (error "could not get volume from amixer backend")))) + + + +(provide 'emms-volume-amixer) + +;;; emms-volume-amixer.el ends here diff --git a/elisp/emms-volume-mixerctl.el b/elisp/emms-volume-mixerctl.el new file mode 100644 index 0000000..72bdfec --- /dev/null +++ b/elisp/emms-volume-mixerctl.el @@ -0,0 +1,80 @@ +;;; emms-volume-mixerctl.el --- a mode for changing volume using mixerctl -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009, 2019 Free Software Foundation, Inc. + +;; Authors: Martin Schoenmakers +;; Bruno Félix Rezende Ribeiro + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file defines a few simple functions to raise or lower the volume +;; using mixerctl. It can be used stand-alone, though it's meant for usage +;; with EMMS, particularly with emms-volume.el + +;;; History: + +;; Jul 06 2019: Based on emms-volume-amixer.el by Martin Schoenmakers + +;;; Todo: + +;; There probably needs to be more configurability, which may in turn +;; mean adding some more functions. +;; Some of this could benefit from adding customize interfaces. + +;;; Code: + +(defcustom emms-volume-mixerctl-control "master" + "The control to change the volume with. +Controls includes \"master\", \"mono\", etc. For a full list of available +controls, run `mixerctl -a' in a shell." + :type '(choice (const :tag "master" "master") + (const :tag "mono" "mono") + (string :tag "Something else: ")) + :group 'emms-volume) + +(defcustom emms-volume-mixerctl-card 0 + "The card number to change volume. +The card is identified by a number. For a full list run `ls +/dev/mixer?*' in a shell." + :type 'integer + :group 'emms-volume) + +;;;###autoload +(defun emms-volume-mixerctl-change (amount) + "Change mixerctl master volume by AMOUNT." + (message "Playback channels: %s" + (with-temp-buffer + (when (zerop + (call-process "mixerctl" nil (current-buffer) nil + "-f" + (format "/dev/mixer%d" emms-volume-mixerctl-card) + (let ((amount-str + (format "%s%d" (if (< amount 0) "-" "+") + (abs amount)))) + (format "outputs.%s=%s,%s" + emms-volume-mixerctl-control + amount-str amount-str)))) + (if (and (forward-line -1) + (re-search-forward "^\\(.*\\):.*->.*,\\(.*\\)$" nil t)) + (format "%s -> %s" (match-string 1) (match-string 2))))))) + +(provide 'emms-volume-mixerctl) + +;;; emms-volume-mixerctl.el ends here diff --git a/elisp/emms-volume-pulse.el b/elisp/emms-volume-pulse.el new file mode 100644 index 0000000..4df9ecf --- /dev/null +++ b/elisp/emms-volume-pulse.el @@ -0,0 +1,127 @@ +;;; emms-volume-pulse.el --- a mode for changing volume using PulseAudio pactl -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2023 Free Software Foundation, Inc. + +;; Author: Rasmus Pank Roulund + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file defines a few simple functions to raise or lower the volume +;; using pactl. It can be used stand-alone, though it's meant for usage +;; with EMMS, particularly with emms-volume.el. +;; +;; To use add the following to your EMMS configuration +;; (setq emms-volume-change-function 'emms-volume-pulse-change) + +;;; History: + +;; Marts 2015: First release. Partly based on emms-volume-amixer.el + +;;; Todo: + +;; There probably needs to be more configurability, which may in turn +;; mean adding some more functions. +;; Some of this could benefit from adding customize interfaces. + +;;; Code: + +(require 'cl-lib) + +;; TODO: it would be great if custom could have +;; choices based on pactl list short sinks | cut -f1-2 + +(defcustom emms-volume-pulse-sink nil + "The sink to use for volume adjustment. + +If nil try to use the default sink. + +See full list of devices on your system by running + pactl list short sinks" + :type '(choice (number :tag "Sink number") + (string :tag "Sink symbolic name") + (const :tag "Default sink" nil)) + :group 'emms-volume) + +;; 'pactl get-sink-volume' was only added recently (version 14.1). +;; When that version is more widespread this function can be +;; simplified +(defun emms-volume--pulse-get-volume () + "Return `emms-volume-pulse-sink' volume." + (let* ((emms-volume-pulse-sink + (if emms-volume-pulse-sink + emms-volume-pulse-sink + (string-trim + (shell-command-to-string + "pactl info | grep 'Default Sink: ' | cut -d ' ' -f3-")))) + (sink-number-p (numberp emms-volume-pulse-sink)) + (output + (shell-command-to-string + (concat "pactl list sinks" "|" + "grep -E -e 'Sink' -e 'Name' -e '^[^a-zA-Z]*Volume'"))) + (volume-string + (car + (reverse + (funcall + (if sink-number-p #'assq #'assoc) + emms-volume-pulse-sink + (mapcar (if sink-number-p 'identity 'cdr) + (cl-loop while + (string-match + (mapconcat #'identity + '(".*Sink[ \t]+\\#\\([0-9]+\\)" + ".*Name:[ \t]\\([^\n]+\\)" + ".*Volume:.*?\\([0-9]+\\)%.*\n?") + "\n") + output) + collect (list (string-to-number (match-string 1 output)) + (match-string 2 output) + (match-string 3 output)) + do (setq output (replace-match "" nil nil output))))))))) + (if volume-string + (string-to-number volume-string) + (error "cannot get volume from sink, check `emms-volume-pulse-sink'")))) + +(defun emms-volume-pulse-limit (v) + "Limit V to the range [0-100]" + (max (min v 100) 0)) + +(defun emms-volume-pulse-get () + "Return the pulse volume." + (emms-volume-pulse-limit + (emms-volume--pulse-get-volume))) + +;;;###autoload +(defun emms-volume-pulse-change (amount) + "Change PulseAudio volume by AMOUNT." + (message "Volume is %s%%" + (let ((pactl (or (executable-find "pactl") + (error "pactl is not in PATH"))) + (next-vol (emms-volume-pulse-limit + (+ (emms-volume--pulse-get-volume) amount)))) + (when (zerop (shell-command + (format "%s set-sink-volume %s %s%%" + pactl + (or emms-volume-pulse-sink "@DEFAULT_SINK@") + next-vol))) + next-vol)))) + +(provide 'emms-volume-pulse) + +;;; emms-volume-pulse.el ends here diff --git a/elisp/emms-volume-sndioctl.el b/elisp/emms-volume-sndioctl.el new file mode 100644 index 0000000..74ca4b3 --- /dev/null +++ b/elisp/emms-volume-sndioctl.el @@ -0,0 +1,72 @@ +;;; emms-volume-sndioctl.el --- a mode for changing volume using sndioctl -*- lexical-binding: t; -*- + +;; Copyright (C) 2006, 2007, 2008, 2009, 2019 Free Software Foundation, Inc. + +;; Authors: Omar Polo + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file defines a few simple functions to raise or lower the +;; volume using sndioctl. It can be used stand-alone, though it's +;; meant for usage with EMMS, particularly with emms-volume.el + +;;; History: + +;; Sep 09 2021: Based on emms-volume-mixerctl.el by Omar Polo + +;;; Code: +(require 'subr-x) + +(defcustom emms-volume-sndioctl-stream "output" + "The stream to change the volume with. +Usually it's the global \"output\". For a full list of available +controls, run `sndioctl' in a shell." + :type '(choice (const :tag "output" "output") + (string :tag "Something else: ")) + :group 'emms-volume) + +(defcustom emms-volume-sndioctl-device nil + "The card number to change volume. +The card is identified by a number. For a full list run `ls +/dev/mixer?*' in a shell." + :type '(choice (const :tag "none" nil) + (string :tag "Device: ")) + :group 'emms-volume) + +;;;###autoload +(defun emms-volume-sndioctl-change (amount) + "Change sndioctl level by AMOUNT." + (message "Playback channels: %s" + (with-temp-buffer + (when (zerop + (apply #'call-process + "sndioctl" nil (current-buffer) nil + `("-n" + ,@(when emms-volume-sndioctl-device + `("-f" ,emms-volume-sndioctl-device)) + ,(format "%s.level=%s%f" + emms-volume-sndioctl-stream + (if (> amount 0) "+" "") + (/ (float amount) 100))))) + (string-trim-right (buffer-string)))))) + +(provide 'emms-volume-sndioctl) + +;;; emms-volume-sndioctl.el ends here diff --git a/elisp/emms-volume.el b/elisp/emms-volume.el new file mode 100644 index 0000000..101185f --- /dev/null +++ b/elisp/emms-volume.el @@ -0,0 +1,171 @@ +;;; emms-volume.el --- Volume functions and a minor mode to adjust volume easily -*- lexical-binding: t; -*- + +;; Copyright (C) 2006-2023 Free Software Foundation, Inc. + +;; Author: Martin Schoenmakers +;; Bruno Félix Rezende Ribeiro + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; EMMS 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 General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; This file provides generally two things: +;; Generic volume setting functions and some appropriate bindings for EMMS +;; playlist buffers. These can also be bound to global keys,however, the +;; second part may be more useful for this. This part provides functions +;; meant to be bound to a global key (the author uses C-c e + and C-c e -), +;; which then temporarily activates a minor mode allowing you to change the +;; volume with just + and -. This mode deactivates a short (configurable) +;; amount of time after the last volume change. This allows for easier volume +;; adjustment without getting in the way. + +;;; History: + +;; May 2006: First stab at writing the minor mode. +;; +;; 30 May 2006: Cleanup and restructuring to fit with EMMS. + +;;; Todo: + +;; Some of this could benefit from adding customize interfaces. + +;;; Code: + + +(require 'emms) +(require 'emms-playlist-mode) +(require 'emms-volume-amixer) +(require 'emms-volume-pulse) +(require 'emms-volume-mixerctl) +(require 'emms-volume-sndioctl) + +;; Customize group +(defgroup emms-volume nil + "Volume setting for EMMS." + :group 'emms) + +(defcustom emms-volume-change-function + (cond + ;; check for sndioctl first to avoid picking up mixerctl or pactl + ;; on OpenBSD. + ((executable-find "sndioctl") #'emms-volume-sndioctl-change) + ((executable-find "amixer") #'emms-volume-amixer-change) + ((executable-find "pactl") #'emms-volume-pulse-change) + ((executable-find "mixerctl") #'emms-volume-mixerctl-change) + (t #'(lambda (_amount) (user-error "%s" "No supported mixer found. Please, define ‘emms-volume-change-function’.")))) + "The function to use to change the volume. +If you have your own functions for changing volume, set this." + :type '(choice (const :tag "Amixer" emms-volume-amixer-change) + (const :tag "MPD" emms-volume-mpd-change) + (const :tag "PulseAudio" emms-volume-pulse-change) + (const :tag "Mixerctl" emms-volume-mixerctl-change) + (const :tag "Sndioctl" emms-volume-sndioctl-change) + (function :tag "Lisp function"))) + +(defcustom emms-volume-change-amount 2 + "The amount to use when raising or lowering the volume using the +emms-volume interface. + +This should be a positive integer." + :type 'integer) + +(defun emms-volume-select-get-function () + "Return the corresponding get function." + (cond ((not emms-volume-change-function) + (error "`emms-volume-change-function' is not set")) + ((eq emms-volume-change-function #'emms-volume-amixer-change) + #'emms-volume-amixer-get) + ((eq emms-volume-change-function #'emms-volume-pulse-change) + #'emms-volume-pulse-get) + (t (error "could not find corresponding volume getter function for %s" + emms-volume-change-function)))) + +(defun emms-volume-get () + "Return the volume as an integer in the range [0-100]." + (funcall (emms-volume-select-get-function))) + +;;;###autoload +(defun emms-volume-raise () + "Raise the volume." + (interactive) + (funcall emms-volume-change-function emms-volume-change-amount)) + +;;;###autoload +(defun emms-volume-lower () + "Lower the volume." + (interactive) + (funcall emms-volume-change-function (- emms-volume-change-amount))) + +(define-key emms-playlist-mode-map (kbd "+") #'emms-volume-raise) +(define-key emms-playlist-mode-map (kbd "-") #'emms-volume-lower) + +;; Code specific to the minor mode. +(define-minor-mode emms-volume-minor-mode + "Allows volume setting with + and - after an initial key combo." + :global t + :init-value nil + :lighter " (+/-)" + :keymap '(("+" . emms-volume-mode-plus) + ("-" . emms-volume-mode-minus))) + +(defvar emms-volume-mode-timeout 2 + "*The timeout in amount of seconds used by `emms-volume-minor-mode'.") + +(defvar emms-volume-mode-timer nil + "The timer `emms-volume-minor-mode' uses.") + +;;;###autoload +(defun emms-volume-mode-plus () + "Raise volume and enable or extend the `emms-volume-minor-mode' timeout." + (interactive) + (emms-volume-raise) + (emms-volume-mode-start-or-extend)) + +;;;###autoload +(defun emms-volume-mode-minus () + "Lower volume and enable or extend the `emms-volume-minor-mode' timeout." + (interactive) + (emms-volume-lower) + (emms-volume-mode-start-or-extend)) + +(defun emms-volume-mode-disable-timer () + "Disable `emms-volume-minor-mode' timer." + (cancel-timer emms-volume-mode-timer) + (setq emms-volume-mode-timer nil)) + +(defun emms-volume-mode-set-timer () + "Set a new `emms-volume-minor-mode' timer." + (when emms-volume-mode-timer + (emms-volume-mode-disable-timer)) + (setq emms-volume-mode-timer (run-at-time emms-volume-mode-timeout + nil + #'emms-volume-mode-timer-timeout))) + +(defun emms-volume-mode-timer-timeout () + "Function to disable `emms-volume-minor-mode' at timeout." + (setq emms-volume-mode-timer nil) + (emms-volume-minor-mode -1)) + +(defun emms-volume-mode-start-or-extend () + "Start `emms-volume-minor-mode' or extend its running time." + (when (null emms-volume-minor-mode) + (emms-volume-minor-mode 1)) + (emms-volume-mode-set-timer)) + +(provide 'emms-volume) +;;; emms-volume.el ends here diff --git a/elisp/emms.el b/elisp/emms.el new file mode 100644 index 0000000..398ee9d --- /dev/null +++ b/elisp/emms.el @@ -0,0 +1,1623 @@ +;;; emms.el --- The Emacs Multimedia System -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2022 Free Software Foundation, Inc. + +;; Author: Jorgen Schäfer , the Emms developers (see AUTHORS file) +;; Maintainer: Yoni Rabkin +;; Version: 16 +;; Keywords: emms, mp3, ogg, flac, music, mpeg, video, multimedia +;; Package-Type: multi +;; Package-Requires: ((cl-lib "0.5") (nadvice "0.3") (seq)) +;; url: https://www.gnu.org/software/emms/ + +;; This file is part of EMMS. + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This is the very core of EMMS. It provides ways to play a track +;; using `emms-start', to go through the playlist using the commands +;; `emms-next' and `emms-previous', to stop the playback using +;; `emms-stop', and to see what's currently playing using `emms-show'. + +;; But in itself, this core is useless, because it doesn't know how to +;; play any tracks --- you need players for this. In fact, it doesn't +;; even know how to find any tracks to consider playing --- for this, +;; you need sources. + +;; A sample configuration is offered in emms-setup.el, and the +;; Friendly Manual in the doc/ directory is both detailed, and kept up +;; to date. + + +;;; Code: +(require 'emms-compat) + +(defvar emms-version "16" + "EMMS version string.") + +;;; User Customization +(defgroup emms nil + "*The Emacs Multimedia System." + :prefix "emms-" + :group 'multimedia + :group 'applications) + +(defgroup emms-player nil + "*Track players for EMMS." + :prefix "emms-player-" + :group 'emms) + +(defgroup emms-source nil + "*Track sources for EMMS." + :prefix "emms-source-" + :group 'emms) + +(defcustom emms-player-list nil + "*List of players that EMMS can use." + :group 'emms + :type '(repeat (symbol :tag "Player"))) + +(defcustom emms-show-format "Currently playing: %s" + "*The format to use for `emms-show'. +Any \"%s\" is replaced by what `emms-track-description-function' returns +for the currently playing track." + :group 'emms + :type 'string) + +(defcustom emms-repeat-playlist nil + "*Non-nil if the EMMS playlist should automatically repeat. +If nil, playback will stop when the last track finishes playing. +If non-nil, EMMS will wrap back to the first track when that happens." + :group 'emms + :type 'boolean) + +(defcustom emms-random-playlist nil + "*Non-nil means that tracks are played randomly. If nil, tracks +are played sequentially." + :group 'emms + :type 'boolean) + +(defcustom emms-repeat-track nil + "Non-nil, playback will repeat current track. If nil, EMMS will play +track by track normally." + :group 'emms + :type 'boolean) + +(defvar-local emms-single-track nil + "Non-nil, play the current track and then stop.") + +(defcustom emms-completing-read-function + (if (and (boundp 'ido-mode) + ido-mode) + 'ido-completing-read + 'completing-read) + "Function to call when prompting user to choose between a list of options. +This should take the same arguments as `completing-read'. Some +possible values are `completing-read' and `ido-completing-read'. +Note that you must set `ido-mode' if using +`ido-completing-read'." + :group 'emms + :type 'function) + +(defcustom emms-track-description-function 'emms-track-simple-description + "*Function for describing an EMMS track in a user-friendly way." + :group 'emms + :type 'function) + +(defcustom emms-player-delay 0 + "The delay to pause after a player finished. +This is a floating-point number of seconds. This is necessary +for some platforms where it takes a bit to free the audio device +after a player has finished. If EMMS is skipping songs, increase +this number." + :type 'number + :group 'emms) + +(defcustom emms-playlist-shuffle-function 'emms-playlist-simple-shuffle + "*The function to use for shuffling the playlist." + :type 'function + :group 'emms) + +(defcustom emms-playlist-sort-function 'emms-playlist-simple-sort + "*The function to use for sorting the playlist." + :type 'function + :group 'emms) + +(defcustom emms-playlist-uniq-function 'emms-playlist-simple-uniq + "*The function to use for removing duplicate tracks in the playlist." + :type 'function + :group 'emms) + +(defcustom emms-sort-lessp-function 'emms-sort-track-name-less-p + "*Function for comparing two EMMS tracks. +The function should return non-nil if and only if the first track +sorts before the second (see `sort')." + :group 'emms + :type 'function) + +(defcustom emms-playlist-buffer-name " *EMMS Playlist*" + "*The default name of the EMMS playlist buffer." + :type 'string + :group 'emms) + +(defcustom emms-playlist-default-major-mode 'emms-playlist-mode + "*The default major mode for EMMS playlist." + :type 'function + :group 'emms) + +(defcustom emms-playlist-insert-track-function 'emms-playlist-simple-insert-track + "*A function to insert a track into the playlist buffer." + :group 'emms + :type 'function) +(make-variable-buffer-local 'emms-playlist-insert-track-function) + +(defcustom emms-playlist-update-track-function 'emms-playlist-simple-update-track + "*A function to update the track at point. +This is called when the track information changed. This also +shouldn't assume that the track has been inserted before." + :group 'emms + :type 'function) +(make-variable-buffer-local 'emms-playlist-insert-track-function) + +(defcustom emms-playlist-delete-track-function 'emms-playlist-simple-delete-track + "*A function to delete the track at point in the playlist buffer." + :group 'emms + :type 'function) +(make-variable-buffer-local 'emms-playlist-delete-track-function) + +(defcustom emms-ok-track-function 'emms-default-ok-track-function + "*Function returns true if we shouldn't skip this track." + :group 'emms + :type 'function) + +(defcustom emms-playlist-source-inserted-hook nil + "*Hook run when a source got inserted into the playlist. +The buffer is narrowed to the new tracks." + :type 'hook + :group 'emms) + +(defcustom emms-playlist-selection-changed-hook nil + "*Hook run after another track is selected in the EMMS playlist." + :group 'emms + :type 'hook) + +(defcustom emms-playlist-cleared-hook nil + "*Hook run after the current EMMS playlist is cleared. +This happens both when the playlist is cleared and when a new +buffer is created for it." + :group 'emms + :type 'hook) + +(defcustom emms-track-initialize-functions nil + "*List of functions to call for each new EMMS track. +This can be used to initialize tracks with various info." + :group 'emms + :type 'hook) + +(defcustom emms-track-info-filters nil + "*List of functions to call when a track changes data, before updating +the display. +These functions are passed the track as an argument." + :group 'emms + :type 'hook) + +(defcustom emms-track-updated-functions nil + "*List of functions to call when a track changes data, after updating +the display. +These functions are passed the track as an argument." + :group 'emms + :type 'hook) + +(defcustom emms-player-started-hook nil + "*Hook run when an EMMS player starts playing." + :group 'emms + :type 'hook + :options '(emms-show)) + +(defcustom emms-player-stopped-hook nil + "*Hook run when an EMMS player is stopped by the user. +See `emms-player-finished-hook'." + :group 'emms + :type 'hook) + +(defcustom emms-player-finished-hook nil + "*Hook run when an EMMS player finishes playing a track. +Please pay attention to the differences between +`emms-player-finished-hook' and `emms-player-stopped-hook'. The +former is called only when the player actually finishes playing a +track; the latter, only when the player is stopped +interactively." + :group 'emms + :type 'hook) + +(defcustom emms-player-next-function 'emms-next-noerror + "*A function run when EMMS thinks the next song should be played." + :group 'emms + :type 'function + :options '(emms-next-noerror + emms-random)) + +(defcustom emms-player-paused-hook nil + "*Hook run when a player is paused or resumed. +Use `emms-player-paused-p' to find the current state." + :group 'emms + :type 'hook) + +(defcustom emms-seek-seconds 10 + "The number of seconds to seek forward or backward when seeking." + :group 'emms + :type 'number) + +(defcustom emms-player-seeked-functions nil + "*Functions called when a player is seeking. +The functions are called with a single argument, the amount of +seconds the player did seek." + :group 'emms + :type 'hook) + +(defcustom emms-player-time-set-functions nil + "*Functions called when a player is setting the elapsed time of a track. +The functions are called with a single argument, the time elapsed +since the beginning of the current track." + :group 'emms + :type 'hook) + +(defcustom emms-cache-get-function nil + "A function to retrieve a track entry from the cache. +This is called with two arguments, the type and the name." + :group 'emms + :type 'function) + +(defcustom emms-cache-set-function nil + "A function to add/set a track entry from the cache. +This is called with three arguments: the type of the track, the +name of the track, and the track itself." + :group 'emms + :type 'function) + +(defcustom emms-cache-modified-function nil + "A function to be called when a track is modified. +The modified track is passed as the argument to this function." + :group 'emms + :type 'function) + +(defcustom emms-directory (expand-file-name "emms" user-emacs-directory) + "*Directory variable from which all other emms file variables are derived." + :group 'emms + :type 'string) + +(defvar emms-player-playing-p nil + "The currently playing EMMS player, or nil.") + +(defvar emms-player-paused-p nil + "Whether the current player is paused or not.") + +(defvar emms-source-old-buffer nil + "The active buffer before a source was invoked. +This can be used if the source depends on the current buffer not +being the playlist buffer.") + +(defvar emms-playlist-buffer nil + "The current playlist buffer, if any.") + +(defvar emms-players-preference-f #'emms-players-default-preference-f + "Default function for player preference.") + + +;;; ------------------------------------------------------------------ +;;; macros +;;; ------------------------------------------------------------------ +;;; These need to be at the top of the file so that compilation works. +(defmacro with-current-emms-playlist (&rest body) + "Run BODY with the current buffer being the current playlist buffer. +This also disables any read-onliness of the current buffer." + `(progn + (when (or (not emms-playlist-buffer) + (not (buffer-live-p emms-playlist-buffer))) + (emms-playlist-current-clear)) + (let ((emms-source-old-buffer (or emms-source-old-buffer + (current-buffer)))) + (with-current-buffer emms-playlist-buffer + (let ((inhibit-read-only t)) + ,@body))))) +(put 'with-current-emms-playlist 'lisp-indent-function 0) +(put 'with-current-emms-playlist 'edebug-form-spec '(body)) + +(defmacro emms-with-inhibit-read-only-t (&rest body) + "Simple wrapper around `inhibit-read-only'." + `(let ((inhibit-read-only t)) + ,@body)) +(put 'emms-with-inhibit-read-only-t 'edebug-form-spec '(body)) + +(defmacro emms-with-widened-buffer (&rest body) + `(save-restriction + (widen) + ,@body)) +(put 'emms-with-widened-buffer 'edebug-form-spec '(body)) + +(defmacro emms-walk-tracks (&rest body) + "Execute BODY for each track in the current buffer, starting at point. +Point will be placed at the beginning of the track before +executing BODY. + +Point will not be restored afterward." + (let ((donep (make-symbol "donep"))) + `(let ((,donep nil)) + ;; skip to first track if not on one + (unless (emms-playlist-track-at (point)) + (condition-case nil + (emms-playlist-next) + (error + (setq ,donep t)))) + ;; walk tracks + (while (not ,donep) + ,@body + (condition-case nil + (emms-playlist-next) + (error + (setq ,donep t))))))) +(put 'emms-walk-tracks 'lisp-indent-function 0) +(put 'emms-walk-tracks 'edebug-form-spec '(body)) + +(defvar emms-player-base-format-list + '("ogg" "mp3" "wav" "mpg" "mpeg" "wmv" "wma" + "mov" "avi" "divx" "ogm" "ogv" "asf" "mkv" + "rm" "rmvb" "mp4" "flac" "vob" "m4a" "ape" + "flv" "webm" "aif" "opus" "spc") + "A list of common formats which player definitions can use.") + + +;;; ------------------------------------------------------------------ +;;; User Interface +;;; ------------------------------------------------------------------ +(defun emms-start () + "Start playing the current track in the EMMS playlist." + (interactive) + (unless emms-player-playing-p + (emms-player-start (emms-playlist-current-selected-track)))) + +(defun emms-stop () + "Stop any current EMMS playback." + (interactive) + (when emms-player-playing-p + (emms-player-stop))) + +(defun emms-next () + "Start playing the next track in the EMMS playlist. +This might behave funny if called from `emms-player-next-function', +so use `emms-next-noerror' in that case." + (interactive) + (when emms-player-playing-p + (emms-stop)) + (emms-playlist-current-select-next) + (emms-start)) + +(defun emms-next-noerror () + "Start playing the next track in the EMMS playlist. +Unlike `emms-next', this function doesn't signal an error when called +at the end of the playlist. +This function should only be called when no player is playing. +This is a good function to put in `emms-player-next-function'." + (interactive) + (when emms-player-playing-p + (error "A track is already being played")) + (cond (emms-repeat-track + (emms-start)) + (emms-single-track ; buffer local + (emms-stop)) + ;; attempt to play the next track but ignore errors + ((condition-case nil + (progn + (emms-playlist-current-select-next) + t) + (error nil)) + (if (funcall emms-ok-track-function + (emms-playlist-current-selected-track)) + (emms-start) + (emms-next-noerror))) + (t + (message "No next track in playlist")))) + +(defun emms-previous () + "Start playing the previous track in the EMMS playlist." + (interactive) + (when emms-player-playing-p + (emms-stop)) + (emms-playlist-current-select-previous) + (emms-start)) + +(defun emms-random () + "Jump to a random track." + (interactive) + (when emms-player-playing-p + (emms-stop)) + (emms-playlist-current-select-random) + (emms-start)) + +(defun emms-pause () + "Pause the current player. +If player hasn't started, then start it now." + (interactive) + (if emms-player-playing-p + (emms-player-pause) + (emms-start))) + +(defun emms-seek (duration) + "Seek the current player by DURATION from its current position. +DURATION can be: + +- A single number, in which case it is interpreted as seconds. + +- A string of form [-][HH:]MM:SS.m, where HH is hours, MM is + minutes, and SS is seconds. + +In both forms seconds can be a floating point number. A negative +value seeks backwards." + (interactive "sDuration to seek: ") + (emms-ensure-player-playing-p) + (emms-player-seek (emms-timespec-to-secs duration))) + +(defun emms-seek-to (timestamp) + "Seek the current player to TIMESTAMP. +TIMESTAMP can be: + +- A single number, in which case it is interpreted as seconds. + +- A string of form [HH:]MM:SS.m, where HH is hours, MM is + minutes, and SS is seconds. + +In both forms seconds can be a floating point number." + (interactive "sTimestamp to seek to: ") + (emms-ensure-player-playing-p) + (emms-player-seek-to (max 0 (emms-timespec-to-secs timestamp)))) + +(defun emms-timespec-to-secs (timespec) + "Convert TIMESPEC to seconds. + +If TIMESPEC is number, use it verbatim. If TIMESPEC is string, +use `emms-timestr-to-secs' for conversion. Otherwise return +zero." + (cond ((numberp timespec) timespec) + ((stringp timespec) (emms-timestr-to-secs timespec)) + (t 0))) + +(defun emms-timestr-to-secs (timespec) + "Convert TIMESPEC to seconds. + +TIMESPEC is assumed to be a string of form [-][[HH:]MM:]SS, where +HH is hours, MM is minutes and SS is seconds. Each element is +converted to number by calling `string-to-number'. Missing or +invalid elements are treated as zeros." + (let ((tokens (split-string timespec ":"))) + (if (= (length tokens) 1) + ;; seconds only + (string-to-number (car tokens)) + ;; HH:MM:SS + (let* ((sign (if (< (string-to-number (car tokens)) 0) -1 1)) + (revtokens (reverse tokens)) + (seconds (abs (string-to-number (or (pop revtokens) "0")))) + (minutes (abs (string-to-number (or (pop revtokens) "0")))) + (hours (abs (string-to-number (or (pop revtokens) "0"))))) + (* sign (+ (* 60 60 hours) (* 60 minutes) seconds)))))) + +(defun emms-seek-forward () + "Seek ten seconds forward." + (interactive) + (when emms-player-playing-p + (emms-player-seek emms-seek-seconds))) + +(defun emms-seek-backward () + "Seek ten seconds backward." + (interactive) + (when emms-player-playing-p + (emms-player-seek (- emms-seek-seconds)))) + +(defun emms-show (&optional insertp) + "Describe the current EMMS track in the minibuffer. +If INSERTP is non-nil, insert the description into the current buffer instead. +This function uses `emms-show-format' to format the current track." + (interactive "P") + (let ((string (if emms-player-playing-p + (format emms-show-format + (emms-track-description + (emms-playlist-current-selected-track))) + "Nothing playing right now"))) + (if insertp + (insert string) + (message "%s" string)))) + +(defun emms-shuffle () + "Shuffle the current playlist. +This uses `emms-playlist-shuffle-function'." + (interactive) + (with-current-emms-playlist + (save-excursion + (funcall emms-playlist-shuffle-function)))) + +(defun emms-sort () + "Sort the current playlist. +This uses `emms-playlist-sort-function'." + (interactive) + (with-current-emms-playlist + (save-excursion + (funcall emms-playlist-sort-function)))) + +(defun emms-uniq () + "Remove duplicates from the current playlist. +This uses `emms-playlist-uniq-function'." + (interactive) + (with-current-emms-playlist + (save-excursion + (funcall emms-playlist-uniq-function)))) + +(defun emms-toggle-single-track () + "Toggle if Emms plays a single track and stops." + (interactive) + (with-current-emms-playlist + (cond (emms-single-track + (setq emms-single-track nil) + (message "single track mode disabled for %s" + (buffer-name))) + (t (setq emms-single-track t) + (message "single track mode enabled for %s" + (buffer-name)))))) + +(defun emms-toggle-random-playlist () + "Toggle whether emms plays the tracks randomly or sequentially. +See `emms-random-playlist'." + (interactive) + (setq emms-random-playlist (not emms-random-playlist)) + (if emms-random-playlist + (progn (setq emms-player-next-function #'emms-random) + (message "Will play the tracks randomly.")) + (setq emms-player-next-function #'emms-next-noerror) + (message "Will play the tracks sequentially."))) + +(defun emms-toggle-repeat-playlist () + "Toggle whether emms repeats the playlist after it is done. +See `emms-repeat-playlist'." + (interactive) + (setq emms-repeat-playlist (not emms-repeat-playlist)) + (if emms-repeat-playlist + (message "Will repeat the playlist after it is done.") + (message "Will stop after the playlist is over."))) + +(defun emms-toggle-repeat-track () + "Toggle whether emms repeats the current track. +See `emms-repeat-track'." + (interactive) + (setq emms-repeat-track (not emms-repeat-track)) + (if emms-repeat-track + (message "Will repeat the current track.") + (message "Will advance to the next track after this one."))) + +(defun emms-sort-track-name-less-p (a b) + "Return non-nil if the track name of A sorts before B." + (string< (emms-track-name a) + (emms-track-name b))) + +(defun emms-ensure-player-playing-p () + "Raise an error if no player is playing right now." + (when (not emms-player-playing-p) + (error "No EMMS player playing right now"))) + +(defun emms-completing-read (&rest args) + "Read a string in the minibuffer, with completion. +Set `emms-completing-read' to determine which function to use. + +See `completing-read' for a description of ARGS." + (apply emms-completing-read-function args)) + +(defun emms-display-modes () + "Display the current EMMS play modes." + (interactive) + (with-current-emms-playlist + (message + "repeat playlist: %s, repeat track: %s, random: %s, single %s" + (if emms-repeat-playlist "yes" "no") + (if emms-repeat-track "yes" "no") + (if emms-random-playlist "yes" "no") + (if emms-single-track "yes" "no")))) + + +;;; ------------------------------------------------------------------ +;;; Utility functions +;;; ------------------------------------------------------------------ +(defun emms-insert-file-contents (filename &optional visit) + "Insert the contents of file FILENAME after point. +Do character code conversion and end-of-line conversion, but none +of the other unnecessary things like format decoding or +`find-file-hook'. + +If VISIT is non-nil, the buffer's visited filename +and last save file modtime are set, and it is marked unmodified. +If visiting and the file does not exist, visiting is completed +before the error is signaled." + (let ((format-alist nil) + (after-insert-file-functions nil) + (inhibit-file-name-handlers + (append '(jka-compr-handler image-file-handler epa-file-handler) + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'insert-file-contents)) + (insert-file-contents filename visit))) + + +;;; ------------------------------------------------------------------ +;;; Dictionaries +;;; ------------------------------------------------------------------ +;; This is a simple helper data structure, used by both players +;; and tracks. +(defsubst emms-dictionary (name) + "Create a new dictionary of type NAME." + (list name)) + +(defsubst emms-dictionary-type (dict) + "Return the type of the dictionary DICT." + (car dict)) + +(defun emms-dictionary-get (dict name &optional default) + "Return the value of NAME in DICT." + (let ((item (assq name (cdr dict)))) + (if item + (cdr item) + default))) + +(defun emms-dictionary-set (dict name value) + "Set the value of NAME in DICT to VALUE." + (let ((item (assq name (cdr dict)))) + (if item + (setcdr item value) + (setcdr dict (append (cdr dict) + (list (cons name value)))))) + dict) + + +;;; ------------------------------------------------------------------ +;;; Tracks +;;; ------------------------------------------------------------------ +;; This is a simple datatype to store track information. +;; Each track consists of a type (a symbol) and a name (a string). +;; In addition, each track has an associated dictionary of information. +(defun emms-track (type name) + "Create an EMMS track with type TYPE and name NAME." + (let ((track (when emms-cache-get-function + (funcall emms-cache-get-function type name)))) + (when (not track) + (setq track (emms-dictionary '*track*)) + ;; Prevent the cache from being called for these two sets + (let ((emms-cache-modified-function nil)) + (emms-track-set track 'type type) + (emms-track-set track 'name name)) + (when emms-cache-set-function + (funcall emms-cache-set-function type name track))) + ;; run any hooks regardless of a cache hit, as the entry may be + ;; old + (run-hook-with-args 'emms-track-initialize-functions track) + track)) + +(defun emms-track-p (obj) + "True if OBJ is an emms track." + (and (listp obj) + (eq (car obj) '*track*))) + +(defun emms-track-type (track) + "Return the type of TRACK." + (emms-track-get track 'type)) + +(defun emms-track-file-p (track) + "True if TRACK is a file type" + (eq 'file (emms-track-type track))) + +(defun emms-track-name (track) + "Return the name of TRACK." + (emms-track-get track 'name)) + +(defun emms-track-get (track name &optional default) + "Return the value of NAME for TRACK. +If there is no value, return DEFAULT (or nil, if not given)." + (emms-dictionary-get track name default)) + +(defun emms-track-set (track name value) + "Set the value of NAME for TRACK to VALUE." + (emms-dictionary-set track name value) + (when emms-cache-modified-function + (funcall emms-cache-modified-function track))) + +(defun emms-track-description (track) + "Return a description of TRACK. +This function uses the global value for +`emms-track-description-function', rather than anything the +current mode might have set. + +Use `emms-track-force-description' instead if you need to insert +a description into a playlist buffer." + (funcall (default-value 'emms-track-description-function) track)) + +(defun emms-track-updated (track) + "Information in TRACK got updated." + (run-hook-with-args 'emms-track-info-filters track) + (emms-playlist-track-updated track) + (run-hook-with-args 'emms-track-updated-functions track)) + +(defun 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 ((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)))))) + +(defun emms-format-url-track-name (name) + "Format URL track name for better readability." + (url-unhex-string name)) + +(defun emms-track-force-description (track) + "Always return text that describes TRACK. +This is used when inserting a description into a buffer. + +The reason for this is that if no text was returned (i.e. the +user defined a track function that returned nil or the empty +string), a confusing error message would result." + (let ((desc (funcall emms-track-description-function track))) + (if (and (stringp desc) (not (string= desc ""))) + desc + (emms-track-simple-description track)))) + +(defun emms-track-get-year (track) + "Get year of TRACK for display. +There is the separation between the \\='release date\\=' and the +\\='original date\\='. This difference matters e.g. for +re-releases (anniversaries and such) where the release date is +more recent than the original release date. In such cases the +user probably wants the original release date so this is what we +show." + (or + (emms-format-date-to-year (emms-track-get track 'info-date)) + (emms-format-date-to-year (emms-track-get track 'info-originaldate)) + (emms-track-get track 'info-year) + (emms-track-get track 'info-originalyear))) + +(defun emms-format-date-to-year (date) + "Try to extract year part from DATE. +Return nil if the year cannot be extracted." + (when date + (let ((year (nth 5 (parse-time-string date)))) + (if year (number-to-string year) + (when (string-match "^[ \t]*\\([0-9]\\{4\\}\\)" date) + (match-string 1 date)))))) + + +;;; ------------------------------------------------------------------ +;;; The Playlist +;;; ------------------------------------------------------------------ +;; Playlists are stored in buffers. The current playlist buffer is +;; remembered in the `emms-playlist' variable. The buffer consists of +;; any kind of data. Strings of text with a `emms-track' property are +;; the tracks in the buffer. +(defvar emms-playlist-buffers nil + "The list of EMMS playlist buffers. +You should use the `emms-playlist-buffer-list' function to +retrieve a current list of EMMS buffers. Never use this variable +for that purpose.") + +(defvar emms-playlist-selected-marker nil + "The marker for the currently selected track.") +(make-variable-buffer-local 'emms-playlist-selected-marker) + +(defvar emms-playlist-buffer-p nil + "Non-nil if the current buffer is an EMMS playlist.") +(make-variable-buffer-local 'emms-playlist-buffer-p) + +(defun emms-playlist-ensure-playlist-buffer () + "Throw an error if we're not in a playlist-buffer." + (when (not emms-playlist-buffer-p) + (error "Not an EMMS playlist buffer"))) + +(defun emms-playlist-set-playlist-buffer (&optional buffer) + "Set the current playlist buffer." + (interactive + (list (let* ((buf-list (mapcar #'(lambda (buf) + (list (buffer-name buf))) + (emms-playlist-buffer-list))) + (sorted-buf-list (sort buf-list + #'(lambda (lbuf rbuf) + (< (length (car lbuf)) + (length (car rbuf)))))) + (default (or (and emms-playlist-buffer-p + ;; default to current buffer + (buffer-name)) + ;; pick shortest buffer name, since it is + ;; likely to be a shared prefix + (car sorted-buf-list)))) + (emms-completing-read "Playlist buffer to make current: " + sorted-buf-list nil t default)))) + (let ((buf (if buffer + (get-buffer buffer) + (current-buffer)))) + (with-current-buffer buf + (emms-playlist-ensure-playlist-buffer)) + (setq emms-playlist-buffer buf) + (when (called-interactively-p 'interactive) + (message "Set current EMMS playlist buffer")) + buf)) + +(defun emms-playlist-new (&optional name) + "Create a new playlist buffer. +The buffer is named NAME, but made unique. NAME defaults to +`emms-playlist-buffer-name'. If called interactively, the new +buffer is also selected." + (interactive) + (let ((buf (generate-new-buffer (or name + emms-playlist-buffer-name)))) + (with-current-buffer buf + (when (not (eq major-mode emms-playlist-default-major-mode)) + (funcall emms-playlist-default-major-mode)) + (setq emms-playlist-buffer-p t)) + (add-to-list 'emms-playlist-buffers buf) + (when (called-interactively-p 'interactive) + (switch-to-buffer buf)) + buf)) + +(defun emms-playlist-buffer-list () + "Return a list of EMMS playlist buffers. +The first element is guaranteed to be the current EMMS playlist +buffer, if it exists, otherwise the slot will be used for the +other EMMS buffers. The list will be in newest-first order." + ;; prune dead buffers + (setq emms-playlist-buffers (emms-delete-if (lambda (buf) + (not (buffer-live-p buf))) + emms-playlist-buffers)) + ;; add new buffers + (mapc (lambda (buf) + (when (buffer-live-p buf) + (with-current-buffer buf + (when (and emms-playlist-buffer-p + (not (memq buf emms-playlist-buffers))) + (setq emms-playlist-buffers + (cons buf emms-playlist-buffers)))))) + (buffer-list)) + ;; force current playlist buffer to head position + (when (and (buffer-live-p emms-playlist-buffer) + (not (eq (car emms-playlist-buffers) emms-playlist-buffer))) + (setq emms-playlist-buffers (cons emms-playlist-buffer + (delete emms-playlist-buffer + emms-playlist-buffers)))) + emms-playlist-buffers) + +(defun emms-playlist-current-kill () + "Kill the current EMMS playlist buffer and switch to the next one." + (interactive) + (when (buffer-live-p emms-playlist-buffer) + (let ((new (cadr (emms-playlist-buffer-list)))) + (if new + (let ((old emms-playlist-buffer)) + (setq emms-playlist-buffer new + emms-playlist-buffers (cdr emms-playlist-buffers)) + (kill-buffer old) + (switch-to-buffer emms-playlist-buffer)) + (with-current-buffer emms-playlist-buffer + (bury-buffer)))))) + +(defun emms-playlist-current-clear () + "Clear the current playlist. +If no current playlist exists, a new one is generated." + (interactive) + (if (or (not emms-playlist-buffer) + (not (buffer-live-p emms-playlist-buffer))) + (setq emms-playlist-buffer (emms-playlist-new)) + (with-current-buffer emms-playlist-buffer + (emms-playlist-clear)))) + +(defun emms-playlist-clear () + "Clear the current buffer." + (interactive) + (emms-playlist-ensure-playlist-buffer) + (let ((inhibit-read-only t)) + (widen) + (delete-region (point-min) + (point-max))) + (run-hooks 'emms-playlist-cleared-hook)) + +;;; Point movement within the playlist buffer. +(defun emms-playlist-track-at (&optional pos) + "Return the track at POS (point if not given), or nil if none." + (emms-playlist-ensure-playlist-buffer) + (emms-with-widened-buffer + (get-text-property (or pos (point)) + 'emms-track))) + +(defun emms-playlist-next () + "Move to the next track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (let ((next (next-single-property-change (point) + 'emms-track))) + (when (not next) + (error "No next track")) + (when (not (emms-playlist-track-at next)) + (setq next (next-single-property-change next 'emms-track))) + (when (or (not next) + (= next (point-max))) + (error "No next track")) + (goto-char next))) + +(defun emms-playlist-previous () + "Move to the previous track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (let ((prev (previous-single-property-change (point) + 'emms-track))) + (when (not prev) + (error "No previous track")) + (when (not (get-text-property prev 'emms-track)) + (setq prev (or (previous-single-property-change prev 'emms-track) + (point-min)))) + (when (or (not prev) + (not (get-text-property prev 'emms-track))) + (error "No previous track")) + (goto-char prev))) + +(defun emms-playlist-first () + "Move to the first track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (let ((first (condition-case nil + (save-excursion + (goto-char (point-min)) + (when (not (emms-playlist-track-at (point))) + (emms-playlist-next)) + (point)) + (error + nil)))) + (if first + (goto-char first) + (error "No first track")))) + +(defun emms-playlist-last () + "Move to the last track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (let ((last (condition-case nil + (save-excursion + (goto-char (point-max)) + (emms-playlist-previous) + (point)) + (error + nil)))) + (if last + (goto-char last) + (error "No last track")))) + +(defun emms-playlist-delete-track () + "Delete the track at point." + (emms-playlist-ensure-playlist-buffer) + (funcall emms-playlist-delete-track-function)) + +;;; Track selection +(defun emms-playlist-selected-track () + "Return the currently selected track." + (emms-playlist-ensure-playlist-buffer) + (when emms-playlist-selected-marker + (emms-playlist-track-at emms-playlist-selected-marker))) + +(defun emms-playlist-current-selected-track () + "Return the currently selected track in the current playlist." + (with-current-emms-playlist + (emms-playlist-selected-track))) + +(defun emms-playlist-selected-track-at-p (&optional point) + "Return non-nil if POINT (defaulting to point) is on the selected track." + (when emms-playlist-selected-marker + (or (= emms-playlist-selected-marker + (or point (point))) + (let ((p (previous-single-property-change (or point (point)) + 'emms-track))) + (when p + (= emms-playlist-selected-marker + p)))))) + +(defun emms-playlist-select (pos) + "Select the track at POS." + (emms-playlist-ensure-playlist-buffer) + (when (not (emms-playlist-track-at pos)) + (error "No track at position %s" pos)) + (when (not emms-playlist-selected-marker) + (setq emms-playlist-selected-marker (make-marker))) + (set-marker-insertion-type emms-playlist-selected-marker t) + (set-marker emms-playlist-selected-marker pos) + (run-hooks 'emms-playlist-selection-changed-hook)) + +(defun emms-playlist-select-next () + "Select the next track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (save-excursion + (goto-char (if (and emms-playlist-selected-marker + (marker-position emms-playlist-selected-marker)) + emms-playlist-selected-marker + (point-min))) + (condition-case nil + (progn + (if emms-repeat-playlist + (condition-case nil + (emms-playlist-next) + (error + (emms-playlist-first))) + (emms-playlist-next)) + (emms-playlist-select (point))) + (error + (error "No next track in playlist"))))) + +(defun emms-playlist-current-select-next () + "Select the next track in the current playlist." + (with-current-emms-playlist + (emms-playlist-select-next))) + +(defun emms-playlist-select-previous () + "Select the previous track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (save-excursion + (goto-char (if (and emms-playlist-selected-marker + (marker-position emms-playlist-selected-marker)) + emms-playlist-selected-marker + (point-max))) + (condition-case nil + (progn + (if emms-repeat-playlist + (condition-case nil + (emms-playlist-previous) + (error + (emms-playlist-last))) + (emms-playlist-previous)) + (emms-playlist-select (point))) + (error + (error "No previous track in playlist"))))) + +(defun emms-playlist-current-select-previous () + "Select the previous track in the current playlist." + (with-current-emms-playlist + (emms-playlist-select-previous))) + +(defun emms-playlist-select-random () + "Select a random track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + ;; FIXME: This is rather inefficient. + (save-excursion + (let ((track-indices nil)) + (goto-char (point-min)) + (emms-walk-tracks + (setq track-indices (cons (point) + track-indices))) + (setq track-indices (vconcat track-indices)) + (emms-playlist-select (aref track-indices + (random (length track-indices))))))) + +(defun emms-playlist-current-select-random () + "Select a random track in the current playlist." + (with-current-emms-playlist + (emms-playlist-select-random))) + +(defun emms-playlist-select-first () + "Select the first track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (save-excursion + (emms-playlist-first) + (emms-playlist-select (point)))) + +(defun emms-playlist-current-select-first () + "Select the first track in the current playlist." + (with-current-emms-playlist + (emms-playlist-select-first))) + +(defun emms-playlist-select-last () + "Select the last track in the current buffer." + (emms-playlist-ensure-playlist-buffer) + (save-excursion + (emms-playlist-last) + (emms-playlist-select (point)))) + +(defun emms-playlist-current-select-last () + "Select the last track in the current playlist." + (with-current-emms-playlist + (emms-playlist-select-last))) + +;;; Playlist manipulation +(defun emms-playlist-insert-track (track) + "Insert TRACK at the current position into the playlist. +This uses `emms-playlist-insert-track-function'." + (emms-playlist-ensure-playlist-buffer) + (funcall emms-playlist-insert-track-function track)) + +(defun emms-playlist-update-track () + "Update TRACK at point. +This uses `emms-playlist-update-track-function'." + (emms-playlist-ensure-playlist-buffer) + (funcall emms-playlist-update-track-function)) + +(defun emms-playlist-insert-source (source &rest args) + "Insert tracks from SOURCE, supplying ARGS as arguments." + (emms-playlist-ensure-playlist-buffer) + (save-restriction + (narrow-to-region (point) + (point)) + (apply source args) + (run-hooks 'emms-playlist-source-inserted-hook))) + +(defun emms-playlist-current-insert-source (source &rest args) + "Insert tracks from SOURCE in the current playlist. +This is supplying ARGS as arguments to the source." + (with-current-emms-playlist + (apply #'emms-playlist-insert-source source args))) + +(defun emms-playlist-tracks-in-region (beg end) + "Return all tracks between BEG and END." + (emms-playlist-ensure-playlist-buffer) + (let ((tracks nil)) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (emms-walk-tracks + (setq tracks (cons (emms-playlist-track-at (point)) + tracks)))) + tracks)) + +(defun emms-playlist-track-updated (track) + "Update TRACK in all playlist buffers." + (mapc (lambda (buf) + (with-current-buffer buf + (when emms-playlist-buffer-p + (save-excursion + (let ((pos (text-property-any (point-min) (point-max) + 'emms-track track))) + (while pos + (goto-char pos) + (emms-playlist-update-track) + (setq pos (text-property-any + (next-single-property-change (point) + 'emms-track) + (point-max) + 'emms-track + track)))))))) + (buffer-list)) + t) + +;;; Simple playlist buffer +(defun emms-playlist-simple-insert-track (track) + "Insert the description of TRACK at point." + (emms-playlist-ensure-playlist-buffer) + (let ((inhibit-read-only t)) + (insert (emms-propertize (emms-track-force-description track) + 'emms-track track) + "\n"))) + +(defun emms-playlist-simple-update-track () + "Update the track at point. +Since we don't do anything special with the track anyway, just +ignore this." + nil) + +(defun emms-playlist-simple-delete-track () + "Delete the track at point." + (emms-playlist-ensure-playlist-buffer) + (when (not (emms-playlist-track-at (point))) + (error "No track at point")) + (let ((inhibit-read-only t) + (region (emms-property-region (point) 'emms-track))) + (delete-region (car region) + (cdr region)))) + +(defun emms-playlist-simple-shuffle () + "Shuffle the whole playlist buffer." + (emms-playlist-ensure-playlist-buffer) + (let ((inhibit-read-only t) + (current nil)) + (widen) + (when emms-player-playing-p + (setq current (emms-playlist-selected-track)) + (goto-char emms-playlist-selected-marker) + (emms-playlist-delete-track)) + (let* ((tracks (vconcat (emms-playlist-tracks-in-region (point-min) + (point-max)))) + (len (length tracks)) + (i 0)) + (delete-region (point-min) + (point-max)) + (run-hooks 'emms-playlist-cleared-hook) + (emms-shuffle-vector tracks) + (when current + (emms-playlist-insert-track current)) + (while (< i len) + (emms-playlist-insert-track (aref tracks i)) + (setq i (1+ i)))) + (emms-playlist-select-first) + (goto-char (point-max)))) + +(defun emms-playlist-simple-sort () + "Sort the whole playlist buffer." + (emms-playlist-ensure-playlist-buffer) + (widen) + (let ((inhibit-read-only t) + (current (emms-playlist-selected-track)) + (tracks (emms-playlist-tracks-in-region (point-min) + (point-max)))) + (delete-region (point-min) + (point-max)) + (run-hooks 'emms-playlist-cleared-hook) + (mapc #'emms-playlist-insert-track + (sort tracks emms-sort-lessp-function)) + (let ((pos (text-property-any (point-min) + (point-max) + 'emms-track current))) + (if pos + (emms-playlist-select pos) + (emms-playlist-first))))) + +(defun emms-uniq-list (list stringify) + "Compare stringfied element of list, and remove duplicate elements." + ;; This uses a fast append list, keeping a pointer to the last cons + ;; cell of the list (TAIL). It might be worthwhile to provide an + ;; abstraction for this eventually. + (let* ((hash (make-hash-table :test 'equal)) + (result (cons nil nil)) + (tail result)) + (dolist (element list) + (let ((str (funcall stringify element))) + (when (not (gethash str hash)) + (setcdr tail (cons element nil)) + (setq tail (cdr tail))) + (puthash str t hash))) + (cdr result))) + +(defun emms-playlist-simple-uniq () + "Remove duplicate tracks." + ;; TODO: This seems unnecessarily destructive. + (emms-playlist-ensure-playlist-buffer) + (widen) + (let ((inhibit-read-only t) + (current (emms-playlist-selected-track)) + (tracks (emms-playlist-tracks-in-region (point-min) + (point-max)))) + (delete-region (point-min) (point-max)) + (run-hooks 'emms-playlist-cleared-hook) + (mapc #'emms-playlist-insert-track + (nreverse + (emms-uniq-list tracks 'emms-track-name))) + (let ((pos (text-property-any (point-min) + (point-max) + 'emms-track current))) + (if pos + (emms-playlist-select pos) + (emms-playlist-first))))) + +(defun emms-default-ok-track-function (track) + "A function which OKs all tracks for playing by default." + (ignore track) ;; explicit ignore + t) + + +;;; ------------------------------------------------------------------ +;;; Helper functions +;;; ------------------------------------------------------------------ +(defun emms-property-region (pos prop) + "Return a pair of the beginning and end of the property PROP at POS. +If POS does not contain PROP, try to find PROP just before POS." + (let (begin end) + (if (and (> pos (point-min)) + (get-text-property (1- pos) prop)) + (setq begin (previous-single-property-change (1- pos) prop)) + (if (get-text-property pos prop) + (setq begin pos) + (error "Cannot find the %s property at the given position" prop))) + (if (get-text-property pos prop) + (setq end (next-single-property-change pos prop)) + (if (and (> pos (point-min)) + (get-text-property (1- pos) prop)) + (setq end pos) + (error "Cannot find the %s property at the given position" prop))) + (cons (or begin (point-min)) + (or end (point-max))))) + +(defun emms-shuffle-vector (vector) + "Shuffle VECTOR." + (let ((i (- (length vector) 1))) + (while (>= i 0) + (let* ((r (random (1+ i))) + (old (aref vector r))) + (aset vector r (aref vector i)) + (aset vector i old)) + (setq i (- i 1)))) + vector) + + +;;; ------------------------------------------------------------------ +;;; Sources +;;; ------------------------------------------------------------------ +;; A source is just a function which is called in a playlist buffer. +;; It should use `emms-playlist-insert-track' to insert the tracks it +;; knows about. +;; +;; The define-emms-source macro also defines functions +;; emms-play-SOURCE and emms-add-SOURCE. The former will replace the +;; current playlist, while the latter will add to the end. +(defmacro define-emms-source (name arglist &rest body) + "Define a new EMMS source called NAME. +This macro defines three functions: `emms-source-NAME', +`emms-play-NAME' and `emms-add-NAME'. BODY should use +`emms-playlist-insert-track' to insert all tracks to be played, +which is exactly what `emms-source-NAME' will do. The other two +functions will be simple wrappers around `emms-source-NAME'; any +`interactive' form that you specify in BODY will end up in these. +See emms-source-file.el for some examples." + (let ((source-name (intern (format "emms-source-%s" name))) + (source-play (intern (format "emms-play-%s" name))) + (source-add (intern (format "emms-add-%s" name))) + (source-insert (intern (format "emms-insert-%s" name))) + (docstring "A source of tracks for EMMS.") + (interactive nil) + (call-args (delete '&rest + (delete '&optional + arglist)))) + (when (stringp (car body)) + (setq docstring (car body) + body (cdr body))) + (when (eq 'interactive (caar body)) + (setq interactive (car body) + body (cdr body))) + `(progn + (defun ,source-name ,arglist + ,docstring + ,@body) + (defun ,source-play ,arglist + ,docstring + ,interactive + (if current-prefix-arg + (let ((current-prefix-arg nil)) + (emms-source-add ',source-name ,@call-args)) + (emms-source-play ',source-name ,@call-args))) + (defun ,source-add ,arglist + ,docstring + ,interactive + (if current-prefix-arg + (let ((current-prefix-arg nil)) + (emms-source-play ',source-name ,@call-args)) + (emms-source-add ',source-name ,@call-args))) + (defun ,source-insert ,arglist + ,docstring + ,interactive + (emms-source-insert ',source-name ,@call-args))))) + +(defun emms-source-play (source &rest args) + "Play the tracks of SOURCE, after first clearing the EMMS playlist." + (emms-stop) + (emms-playlist-current-clear) + (apply #'emms-playlist-current-insert-source source args) + (emms-playlist-current-select-first) + (emms-start)) + +(defun emms-source-add (source &rest args) + "Add the tracks of SOURCE at the current position in the playlist." + (with-current-emms-playlist + (save-excursion + (goto-char (point-max)) + (apply #'emms-playlist-current-insert-source source args)) + (when (or (not emms-playlist-selected-marker) + (not (marker-position emms-playlist-selected-marker))) + (emms-playlist-select-first)))) + +(defun emms-source-insert (source &rest args) + "Insert the tracks from SOURCE in the current buffer." + (if (not emms-playlist-buffer-p) + (error "Not in an EMMS playlist buffer") + (apply #'emms-playlist-insert-source source args))) + +;;; User-defined playlists +;;; FIXME: Shuffle is bogus here! (because of narrowing) +(defmacro define-emms-combined-source (name shufflep sources) + "Define a `emms-play-X' and `emms-add-X' function for SOURCES." + `(define-emms-source ,name () + "An EMMS source for a tracklist." + (interactive) + (mapc (lambda (source) + (apply (car source) + (cdr source))) + ,sources) + ,(when shufflep + '(save-restriction + (widen) + (emms-shuffle))))) + + +;;; ------------------------------------------------------------------ +;;; Players +;;; ------------------------------------------------------------------ +;; A player is a data structure created by `emms-player'. +;; See the docstring of that function for more information. +(defvar emms-player-stopped-p nil + "Non-nil if the last EMMS player was stopped by the user.") + +(defun emms-player (start stop playablep) + "Create a new EMMS player. +The start function will be START, and the stop function STOP. +PLAYABLEP should return non-nil for tracks that this player can +play. + +When trying to play a track, EMMS walks through +`emms-player-list'. For each player, it calls the PLAYABLEP +function. The player corresponding to the first PLAYABLEP +function that returns non-nil is used to play the track. To +actually play the track, EMMS calls the START function, passing +the chosen track as a parameter. + +If the user tells EMMS to stop playing, the STOP function is +called. Once the player has finished playing, it should call +`emms-player-stopped' to let EMMS know." + (let ((p (emms-dictionary '*player*))) + (emms-player-set p 'start start) + (emms-player-set p 'stop stop) + (emms-player-set p 'playablep playablep) + p)) + +(defun emms-player-get (player name &optional inexistent) + "Return the value of entry NAME in PLAYER." + (let ((p (if (symbolp player) + (symbol-value player) + player))) + (emms-dictionary-get p name inexistent))) + +(defun emms-player-set (player name value) + "Set the value of entry NAME in PLAYER to VALUE." + (let ((p (if (symbolp player) + (symbol-value player) + player))) + (emms-dictionary-set p name value))) + +(defun emms-player-for (track) + "Return an EMMS player capable of playing TRACK. +This will be the first player whose PLAYABLEP function returns +non-nil, or nil if no such player exists." + (let ((lis emms-player-list)) + (while (and lis + (not (funcall (emms-player-get (car lis) 'playablep) + track))) + (setq lis (cdr lis))) + (if lis + (car lis) + nil))) + +(defun emms-players-default-preference-f (track players) + "Default preference function. + +Returns the first player." + (ignore track) + (car players)) + +(defun emms-players-preference (track players) + "Call `emms-players-preference-f' with TRACK and PLAYERS. + +The function `emms-players-preference-f' must accept an Emms +track and a list of players. It can be assumed that all of the +players in PLAYERS can play TRACK. + +The function must return one of the players from PLAYERS." + (funcall emms-players-preference-f track players)) + +(defun emms-players-for (track) + "Return a player for TRACK. + +If the track can be played by more than one player, call +`emms-players-preference' to choose a player." + (let (players) + (mapc + #'(lambda (player) + (when (funcall (emms-player-get player 'playablep) track) + (push player players))) + emms-player-list) + (setq players (nreverse players)) + (if (< 1 (length players)) + (emms-players-preference track players) + (car players)))) + +(defun emms-player-start (track) + "Start playing TRACK." + (if emms-player-playing-p + (error "A player is already playing") + (let ((player (emms-players-for track))) + (when (not emms-player-list) + (error "emms-player-list empty")) + (if (not player) + (error "Don't know how to play track: %S" track) + ;; Change default-directory so we don't accidentally block any + ;; directories the current buffer was visiting. + (let ((default-directory "/")) + (funcall (emms-player-get player 'start) + track)))))) + +(defun emms-player-started (player) + "Declare that the given EMMS PLAYER has started. +This should only be done by the current player itself." + (setq emms-player-playing-p player + emms-player-paused-p nil) + (run-hooks 'emms-player-started-hook)) + +(defun emms-player-stop () + "Stop the current EMMS player." + (when emms-player-playing-p + (let ((emms-player-stopped-p t)) + (funcall (emms-player-get emms-player-playing-p 'stop))) + (setq emms-player-playing-p nil))) + +(defun emms-player-stopped () + "Declare that the current EMMS player is finished. +This should only be done by the current player itself." + (setq emms-player-playing-p nil) + (if emms-player-stopped-p + (run-hooks 'emms-player-stopped-hook) + (sleep-for emms-player-delay) + (run-hooks 'emms-player-finished-hook) + (funcall emms-player-next-function))) + +(defun emms-player-pause () + "Pause the current EMMS player." + (cond + ((not emms-player-playing-p) + (error "Can't pause player, nothing is playing")) + (emms-player-paused-p + (let ((resume (emms-player-get emms-player-playing-p 'resume)) + (pause (emms-player-get emms-player-playing-p 'pause))) + (cond + (resume + (funcall resume)) + (pause + (funcall pause)) + (t + (error "Player does not know how to pause")))) + (setq emms-player-paused-p nil) + (run-hooks 'emms-player-paused-hook)) + (t + (let ((pause (emms-player-get emms-player-playing-p 'pause))) + (if pause + (funcall pause) + (error "Player does not know how to pause"))) + (setq emms-player-paused-p t) + (run-hooks 'emms-player-paused-hook)))) + +(defun emms-player-seek (seconds) + "Seek the current player by SECONDS seconds. +This can be a floating point number for fractions of a second, or +negative to seek backwards." + (if (not emms-player-playing-p) + (error "Can't seek player, nothing playing right now") + (let ((seek (emms-player-get emms-player-playing-p 'seek))) + (if (not seek) + (error "Player does not know how to seek") + (funcall seek seconds) + (run-hook-with-args 'emms-player-seeked-functions seconds))))) + +(defun emms-player-seek-to (seconds) + "Seek the current player to SECONDS seconds. +This can be a floating point number for fractions of a second, or +negative to seek backwards." + (if (not emms-player-playing-p) + (error "Can't seek-to player, nothing playing right now") + (let ((seek (emms-player-get emms-player-playing-p 'seek-to))) + (if (not seek) + (error "Player does not know how to seek-to") + (funcall seek seconds) + (run-hook-with-args 'emms-player-time-set-functions seconds))))) + +(provide 'emms) +;;; emms.el ends here -- cgit v1.2.3