From 67f5263943276faee0de53d947b6191205ae7a43 Mon Sep 17 00:00:00 2001 From: William Xu Date: Tue, 17 Jun 2008 14:43:45 +0900 Subject: *.el -> lisp/*.el: Move lisp files into "lisp/" subdirectory. --- Makefile | 34 +- emms-auto.in | 13 - emms-bookmarks.el | 153 --- emms-browser.el | 1959 ------------------------------------- emms-cache.el | 180 ---- emms-compat.el | 162 --- emms-history.el | 125 --- emms-i18n.el | 164 ---- emms-info-libtag.el | 81 -- emms-info-metaflac.el | 107 -- emms-info-mp3info.el | 103 -- emms-info-ogg.el | 92 -- emms-info-ogginfo.el | 85 -- emms-info.el | 135 --- emms-last-played.el | 123 --- emms-lastfm.el | 673 ------------- emms-lyrics.el | 520 ---------- emms-maint.el | 1 - emms-mark.el | 296 ------ emms-metaplaylist-mode.el | 184 ---- emms-mode-line-icon.el | 79 -- emms-mode-line.el | 157 --- emms-player-mpd.el | 1198 ----------------------- emms-player-mpg321-remote.el | 222 ----- emms-player-mplayer.el | 83 -- emms-player-simple.el | 212 ---- emms-player-xine.el | 92 -- emms-playing-time.el | 226 ----- emms-playlist-limit.el | 177 ---- emms-playlist-mode.el | 614 ------------ emms-playlist-sort.el | 204 ---- emms-score.el | 284 ------ emms-setup.el | 151 --- emms-source-file.el | 298 ------ emms-source-playlist.el | 480 --------- emms-stream-info.el | 744 -------------- emms-streams.el | 652 ------------ emms-tag-editor.el | 742 -------------- emms-url.el | 109 --- emms-volume-amixer.el | 67 -- emms-volume.el | 144 --- emms.el | 1391 -------------------------- jack.el | 368 ------- later-do.el | 76 -- lisp/Makefile | 28 + lisp/emms-auto.in | 13 + lisp/emms-bookmarks.el | 153 +++ lisp/emms-browser.el | 1959 +++++++++++++++++++++++++++++++++++++ lisp/emms-cache.el | 180 ++++ lisp/emms-compat.el | 162 +++ lisp/emms-history.el | 125 +++ lisp/emms-i18n.el | 164 ++++ lisp/emms-info-libtag.el | 81 ++ lisp/emms-info-metaflac.el | 107 ++ lisp/emms-info-mp3info.el | 103 ++ lisp/emms-info-ogg.el | 92 ++ lisp/emms-info-ogginfo.el | 85 ++ lisp/emms-info.el | 135 +++ lisp/emms-last-played.el | 123 +++ lisp/emms-lastfm.el | 673 +++++++++++++ lisp/emms-lyrics.el | 520 ++++++++++ lisp/emms-maint.el | 1 + lisp/emms-mark.el | 296 ++++++ lisp/emms-metaplaylist-mode.el | 184 ++++ lisp/emms-mode-line-icon.el | 79 ++ lisp/emms-mode-line.el | 157 +++ lisp/emms-player-mpd.el | 1198 +++++++++++++++++++++++ lisp/emms-player-mpg321-remote.el | 222 +++++ lisp/emms-player-mplayer.el | 83 ++ lisp/emms-player-simple.el | 212 ++++ lisp/emms-player-xine.el | 92 ++ lisp/emms-playing-time.el | 226 +++++ lisp/emms-playlist-limit.el | 177 ++++ lisp/emms-playlist-mode.el | 614 ++++++++++++ lisp/emms-playlist-sort.el | 204 ++++ lisp/emms-score.el | 284 ++++++ lisp/emms-setup.el | 151 +++ lisp/emms-source-file.el | 298 ++++++ lisp/emms-source-playlist.el | 480 +++++++++ lisp/emms-stream-info.el | 744 ++++++++++++++ lisp/emms-streams.el | 652 ++++++++++++ lisp/emms-tag-editor.el | 742 ++++++++++++++ lisp/emms-url.el | 109 +++ lisp/emms-volume-amixer.el | 67 ++ lisp/emms-volume.el | 144 +++ lisp/emms.el | 1391 ++++++++++++++++++++++++++ lisp/jack.el | 368 +++++++ lisp/later-do.el | 76 ++ lisp/ogg-comment.el | 270 +++++ lisp/tq.el | 172 ++++ ogg-comment.el | 270 ----- tq.el | 172 ---- 92 files changed, 14406 insertions(+), 14392 deletions(-) delete mode 100644 emms-auto.in delete mode 100644 emms-bookmarks.el delete mode 100644 emms-browser.el delete mode 100644 emms-cache.el delete mode 100644 emms-compat.el delete mode 100644 emms-history.el delete mode 100644 emms-i18n.el delete mode 100644 emms-info-libtag.el delete mode 100644 emms-info-metaflac.el delete mode 100644 emms-info-mp3info.el delete mode 100644 emms-info-ogg.el delete mode 100644 emms-info-ogginfo.el delete mode 100644 emms-info.el delete mode 100644 emms-last-played.el delete mode 100644 emms-lastfm.el delete mode 100644 emms-lyrics.el delete mode 100644 emms-maint.el delete mode 100644 emms-mark.el delete mode 100644 emms-metaplaylist-mode.el delete mode 100644 emms-mode-line-icon.el delete mode 100644 emms-mode-line.el delete mode 100644 emms-player-mpd.el delete mode 100644 emms-player-mpg321-remote.el delete mode 100644 emms-player-mplayer.el delete mode 100644 emms-player-simple.el delete mode 100644 emms-player-xine.el delete mode 100644 emms-playing-time.el delete mode 100644 emms-playlist-limit.el delete mode 100644 emms-playlist-mode.el delete mode 100644 emms-playlist-sort.el delete mode 100644 emms-score.el delete mode 100644 emms-setup.el delete mode 100644 emms-source-file.el delete mode 100644 emms-source-playlist.el delete mode 100644 emms-stream-info.el delete mode 100644 emms-streams.el delete mode 100644 emms-tag-editor.el delete mode 100644 emms-url.el delete mode 100644 emms-volume-amixer.el delete mode 100644 emms-volume.el delete mode 100644 emms.el delete mode 100644 jack.el delete mode 100644 later-do.el create mode 100644 lisp/Makefile create mode 100644 lisp/emms-auto.in create mode 100644 lisp/emms-bookmarks.el create mode 100644 lisp/emms-browser.el create mode 100644 lisp/emms-cache.el create mode 100644 lisp/emms-compat.el create mode 100644 lisp/emms-history.el create mode 100644 lisp/emms-i18n.el create mode 100644 lisp/emms-info-libtag.el create mode 100644 lisp/emms-info-metaflac.el create mode 100644 lisp/emms-info-mp3info.el create mode 100644 lisp/emms-info-ogg.el create mode 100644 lisp/emms-info-ogginfo.el create mode 100644 lisp/emms-info.el create mode 100644 lisp/emms-last-played.el create mode 100644 lisp/emms-lastfm.el create mode 100644 lisp/emms-lyrics.el create mode 100644 lisp/emms-maint.el create mode 100644 lisp/emms-mark.el create mode 100644 lisp/emms-metaplaylist-mode.el create mode 100644 lisp/emms-mode-line-icon.el create mode 100644 lisp/emms-mode-line.el create mode 100644 lisp/emms-player-mpd.el create mode 100644 lisp/emms-player-mpg321-remote.el create mode 100644 lisp/emms-player-mplayer.el create mode 100644 lisp/emms-player-simple.el create mode 100644 lisp/emms-player-xine.el create mode 100644 lisp/emms-playing-time.el create mode 100644 lisp/emms-playlist-limit.el create mode 100644 lisp/emms-playlist-mode.el create mode 100644 lisp/emms-playlist-sort.el create mode 100644 lisp/emms-score.el create mode 100644 lisp/emms-setup.el create mode 100644 lisp/emms-source-file.el create mode 100644 lisp/emms-source-playlist.el create mode 100644 lisp/emms-stream-info.el create mode 100644 lisp/emms-streams.el create mode 100644 lisp/emms-tag-editor.el create mode 100644 lisp/emms-url.el create mode 100644 lisp/emms-volume-amixer.el create mode 100644 lisp/emms-volume.el create mode 100644 lisp/emms.el create mode 100644 lisp/jack.el create mode 100644 lisp/later-do.el create mode 100644 lisp/ogg-comment.el create mode 100644 lisp/tq.el delete mode 100644 ogg-comment.el delete mode 100644 tq.el diff --git a/Makefile b/Makefile index b8d6930..89eb807 100644 --- a/Makefile +++ b/Makefile @@ -1,14 +1,10 @@ -EMACS=emacs -SITEFLAG=--no-site-file GZIP=gzip -ALLSOURCE=$(wildcard *.el) -ALLCOMPILED=$(wildcard *.elc) -SPECIAL=emms-auto.el emms-maint.el -SOURCE=$(filter-out $(SPECIAL),$(ALLSOURCE)) -TARGET=$(patsubst %.el,%.elc,$(SOURCE)) MAN1PAGES=emms-print-metadata.1 - DOCDIR=doc/ +LISPDIR=lisp + +ALLSOURCE=$(wildcard $(LISPDIR)/*.el) +ALLCOMPILED=$(wildcard $(LISPDIR)/*.elc) DESTDIR= PREFIX=$(DESTDIR)/usr/local @@ -18,27 +14,16 @@ SITELISP=$(PREFIX)/share/emacs/site-lisp/emms INSTALLINFO = /usr/sbin/install-info --info-dir=$(INFODIR) -.PHONY: all install docs deb-install clean +.PHONY: all install lisp docs deb-install clean .PRECIOUS: %.elc -all: $(TARGET) emms-auto.el docs +all: lisp docs -emms-auto.el: emms-auto.in $(SOURCE) - cp emms-auto.in emms-auto.el - -rm -f emms-auto.elc - @$(EMACS) -q $(SITEFLAG) -batch \ - -l emms-maint.el \ - -l emms-auto.el \ - -f generate-autoloads \ - $(shell pwd)/emms-auto.el . +lisp: + $(MAKE) -C $(LISPDIR) docs: $(MAKE) -C $(DOCDIR) -%.elc: %.el - @$(EMACS) -q $(SITEFLAG) -batch \ - -l emms-maint.el \ - -f batch-byte-compile $< - emms-print-metadata: emms-print-metadata.c $(CC) -o $@ $< -I/usr/include/taglib -L/usr/lib -ltag_c @@ -61,4 +46,5 @@ ChangeLog: darcs changes > $@ clean: - -rm -f *~ *.elc emms-auto.el $(DOCDIR)emms.info $(DOCDIR)emms.html emms-print-metadata + -rm -f *~ $(DOCDIR)emms.info $(DOCDIR)emms.html emms-print-metadata + $(MAKE) -C $(LISPDIR) clean diff --git a/emms-auto.in b/emms-auto.in deleted file mode 100644 index 78c71ef..0000000 --- a/emms-auto.in +++ /dev/null @@ -1,13 +0,0 @@ -;;; -*-emacs-lisp-*- - -(defvar generated-autoload-file) -(defvar command-line-args-left) -(defun generate-autoloads () - (interactive) - (require 'autoload) - (setq generated-autoload-file (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left)) - (batch-update-autoloads)) - -(provide 'emms-auto) -;;; Generated autoloads follow (made by autoload.el). diff --git a/emms-bookmarks.el b/emms-bookmarks.el deleted file mode 100644 index c470bc3..0000000 --- a/emms-bookmarks.el +++ /dev/null @@ -1,153 +0,0 @@ -;;; emms-bookmarks.el --- Bookmarks for Emms. - -;; Copyright (C) 2006, 2007 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) -;; into 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 promting 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/emms-browser.el b/emms-browser.el deleted file mode 100644 index f8760f8..0000000 --- a/emms-browser.el +++ /dev/null @@ -1,1959 +0,0 @@ -;;; emms-browser.el --- a track browser supporting covers and filtering - -;; Copyright (C) 2006, 2007 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) - -;; Key bindings -;; ------------------------------------------------------------------- - -;; C-j emms-browser-add-tracks-and-play -;; RET emms-browser-add-tracks -;; SPC emms-browser-toggle-subitems -;; / emms-isearch-buffer -;; 1 emms-browser-collapse-all -;; 2 emms-browser-expand-to-level-2 -;; 3 emms-browser-expand-to-level-3 -;; 4 emms-browser-expand-to-level-4 -;; < emms-browser-previous-filter -;; > emms-browser-next-filter -;; ? describe-mode -;; C emms-browser-clear-playlist -;; E emms-browser-expand-all -;; d emms-browser-view-in-dired -;; d emms-browser-delete-files -;; q emms-browser-bury-buffer -;; r emms-browser-goto-random -;; n next-line -;; p previous-line -;; C-/ emms-playlist-mode-undo -;; emms-browser-add-tracks-and-play -;; emms-browser-prev-non-track -;; emms-browser-next-non-track - -;; s A emms-browser-search-by-album -;; s a emms-browser-search-by-artist -;; s c emms-browser-search-by-composer -;; s s emms-browser-search-by-names -;; s t emms-browser-search-by-title -;; s p emms-browser-search-by-performer - -;; b 1 emms-browse-by-artist -;; b 2 emms-browse-by-album -;; b 3 emms-browse-by-genre -;; b 4 emms-browse-by-year -;; b 5 emms-browse-by-composer -;; b 6 emms-browse-by-performer - -;; W a p emms-browser-lookup-album-on-pitchfork -;; W a w emms-browser-lookup-album-on-wikipedia - -;; W A p emms-browser-lookup-artist-on-pitchfork -;; W A w emms-browser-lookup-artist-on-wikipedia - -;; W C p emms-browser-lookup-composer-on-pitchfork -;; W C w emms-browser-lookup-composer-on-wikipedia - -;; W P p emms-browser-lookup-performer-on-pitchfork -;; W P w emms-browser-lookup-performer-on-wikipedia - -;; 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. - -;; (defadvice emms-browser-next-mapping-type -;; (after no-album (current-mapping)) -;; (when (eq ad-return-value 'info-album) -;; (setq ad-return-value 'info-title))) - -;; (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 'emms) -(require 'emms-cache) -(require 'emms-source-file) -(require 'emms-playlist-sort) -(require 'sort) - -(eval-when-compile - (require 'cl)) - -;; -------------------------------------------------- -;; Variables and configuration -;; -------------------------------------------------- - -(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." - :group 'emms-browser - :type 'function) - -(defcustom emms-browser-make-name-function - 'emms-browser-make-name-standard - "*A function to make names for entries and subentries. -Overriding this function allows you to customise how various elements -are displayed. It is called with two arguments - track and type." - :group 'emms-browser - :type 'function) - -(defcustom emms-browser-get-track-field-function - 'emms-browser-get-track-field-simple - "*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." - :group 'emms-browser - :type 'function) - -(defcustom emms-browser-covers - '("cover_small.jpg" "cover_med.jpg" "cover_large.jpg") - "*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." - :group 'emms-browser - :type '(choice list function boolean)) - -(defcustom emms-browser-default-covers nil - "*A list of default images to use if a cover isn't found." - :group 'emms-browser - :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." - :group 'emms-browser - :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." - :group 'emms-browser - :type 'function) - -(defcustom emms-browser-alpha-sort-function - 'string< - "*How to sort artists/albums/etc. in the browser. -Use nil for no sorting." - :group 'emms-browser - :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." - :group 'emms-browser - :type 'function) - -(defcustom emms-browser-show-display-hook nil - "*Hooks to run when starting or switching to a browser buffer." - :group 'emms-browser - :type 'hook) - -(defcustom emms-browser-hide-display-hook nil - "*Hooks to run when burying or removing a browser buffer." - :group 'emms-browser - :type 'hook) - -(defcustom emms-browser-tracks-added-hook nil - "*Hooks to run when tracks are added to the playlist." - :group 'emms-browser - :type 'hook) - -(defcustom emms-browser-filter-tracks-hook nil - "*Given a track, return t if the track should be ignored." - :group 'emms-browser - :type 'hook) - -(defcustom emms-browser-filter-changed-hook nil - "*Hook run after the filter has changed." - :group 'emms-browser - :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." - :group 'emms-browser - :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-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-hash) - -(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.") - -(defconst 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 "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-next-non-track) - (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 A p") 'emms-browser-lookup-artist-on-pitchfork) - (define-key map (kbd "W C w") 'emms-browser-lookup-composer-on-wikipedia) - (define-key map (kbd "W C p") 'emms-browser-lookup-composer-on-pitchfork) - (define-key map (kbd "W P w") 'emms-browser-lookup-performer-on-wikipedia) - (define-key map (kbd "W P p") 'emms-browser-lookup-performer-on-pitchfork) - (define-key map (kbd "W a w") 'emms-browser-lookup-album-on-wikipedia) - (define-key map (kbd "W a p") 'emms-browser-lookup-album-on-pitchfork) - (define-key map (kbd ">") 'emms-browser-next-filter) - (define-key map (kbd "<") 'emms-browser-previous-filter) - map) - "Keymap for `emms-browser-mode'.") - -(defconst 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) - (defalias 'emms-browser-with-selected-window 'with-selected-window) - (defmacro emms-browser-with-selected-window (window &rest body) - ;; 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)) - - (if (fboundp 'run-mode-hooks) - (defalias 'emms-browser-run-mode-hooks 'run-mode-hooks) - (defalias 'emms-browser-run-mode-hooks 'run-hooks))) - -;; -------------------------------------------------- -;; General mode setup -;; -------------------------------------------------- - -(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)))) - -(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." - (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) - (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)) - (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)) - (sort-lines nil (point-min) (point-max))))) - -(defun case-fold-string= (a b) - (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-year-number (track) - "Return a string representation of a track's year. -This will be in the form '(1998) '." - (let ((year (emms-track-get track 'info-year))) - (if (or (not (stringp year)) (string= year "0")) - "" - (concat - "(" year ") ")))) - -(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'." - `(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'." - `(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 (point-at-bol) - '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." - (let ((moved nil) - (continue t) - (current-level (emms-browser-level-at-point))) - (while (and - continue - (zerop (forward-line - (or direction -1)))) - (when (> current-level (emms-browser-level-at-point)) - (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) - (assert (emms-browser-move-up-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 (point-at-bol 2))) - (emms-with-inhibit-read-only-t - (delete-region next-line - (save-excursion - (while - (emms-browser-find-entry-more-than-level - current-level)) - (point-at-bol 2))))))) - -;; -------------------------------------------------- -;; Dealing with the playlist (queuing songs, etc) -;; -------------------------------------------------- - -(defun emms-browser-playlist-insert-group (bdata) - "Insert a group description into the playlist buffer." - (let* ((type (emms-browser-bdata-type bdata)) - (short-type (substring (symbol-name type) 5)) - (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)) - (track (car (emms-browser-bdata-data bdata)))) - (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)) - (name (emms-browser-bdata-name 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." - (goto-char (point-min)) - (while (not (eq (buffer-end 1) (point))) - (if (< (emms-browser-level-at-point) level) - (emms-browser-show-subitems)) - (emms-browser-next-non-track)) - (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 (point-at-bol) - (point-at-eol) - (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 (point-at-bol) - (point-at-eol) - (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 (point-at-bol)) - (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. -Return the previous point-max before adding." - (interactive) - (let ((first-new-track (with-current-emms-playlist (point-max))) - (bdata (emms-browser-bdata-at-point))) - (emms-browser-playlist-insert-bdata - bdata (emms-browser-bdata-level bdata)) - (run-hook-with-args 'emms-browser-tracks-added-hook - first-new-track) - 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))))) - -(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 () - (interactive) - (when emms-browser-seed-pending - (random t) - (setq emms-browser-seed-pending nil)) - (goto-line (random (count-lines (point-min) (point-max))))) - -(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-delete-files () - "Delete all files under point. -Disabled by default." - (interactive) - (let ((tracks (emms-browser-tracks-at-point)) - dirs path) - (unless (yes-or-no-p - (format "Really permanently delete these %d tracks? " - (length tracks))) - (error "Cancelled!")) - (message "Deleting files..") - (dolist (track tracks) - (setq path (emms-track-get track 'name)) - (delete-file path) - (add-to-list 'dirs (file-name-directory path)) - (emms-cache-del path)) - ;; remove empty dirs - (dolist (dir dirs) - (run-hook-with-args 'emms-browser-delete-files-hook dir tracks) - (condition-case nil - (delete-directory dir) - (error nil))) - ;; remove the item from the browser - (emms-browser-delete-current-node) - (message "Deleting files..done"))) - -(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-pitchfork (field) - (emms-browser-lookup - field "http://www.pitchforkmedia.com/search/record_reviews/query?query[keywords]=")) - -(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)) - -(defun emms-browser-lookup-artist-on-pitchfork () - (interactive) - (emms-browser-lookup-pitchfork 'info-artist)) - -(defun emms-browser-lookup-composer-on-pitchfork () - (interactive) - (emms-browser-lookup-pitchfork 'info-composer)) - -(defun emms-browser-lookup-performer-on-pitchfork () - (interactive) - (emms-browser-lookup-pitchfork 'info-performer)) - -(defun emms-browser-lookup-album-on-pitchfork () - (interactive) - (emms-browser-lookup-pitchfork '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." - :group 'emms-browser - :type 'boolean) - -(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-to-list 'emms-browser-show-display-hook - 'emms-browser-display-playlist) - (add-to-list 'emms-browser-hide-display-hook - 'emms-browser-hide-linked-window) - ;; switch to the playlist window when adding tracks? - (add-to-list '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 buf) - (cond - ((eq major-mode 'emms-browser-mode) - (setq buf (emms-browser-get-linked-buffer)) - (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)) - ;; 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-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)) - (when (string-match (cadr item) - (emms-track-get 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*")) - (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-get-cover-from-album (bdata &optional size) - (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)) - (concat (file-name-directory path) - (nth size-idx emms-browser-covers)))))) - (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)) ?\ ))) - -(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 track 'info-year)) - ("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)) - ("T" . ,(emms-browser-track-number track)) - ("cS" . ,(emms-browser-get-cover-str path 'small)) - ("cM" . ,(emms-browser-get-cover-str path 'medium)) - ("cL" . ,(emms-browser-get-cover-str path 'large)))) - str) - - (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 (cdr (assoc spec specification)))) - (unless val - (error "Invalid format character: %s" spec)) - ;; 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.") - :group 'emms-browser-mode))) - -(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 (path) - "Generate a function which checks if a track is in path. -If the track is not in path, return t." - `(lambda (track) - (not (string-match ,(concat "^" (expand-file-name path)) - (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 (quote ,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)))))) - -(provide 'emms-browser) -;;; emms-browser.el ends here diff --git a/emms-cache.el b/emms-cache.el deleted file mode 100644 index 9c6ae5f..0000000 --- a/emms-cache.el +++ /dev/null @@ -1,180 +0,0 @@ -;;; emms-cache.el --- persistence for emms-track - -;; Copyright (C) 2006, 2007 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: - -;; 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 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 - (add-hook 'after-init-hook 'emms-cache-restore) - (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 'after-init-hook 'emms-cache-restore) - (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." - (gethash path emms-cache-db)) - -;; Note we ignore TYPE, as it's stored in TRACK -(defun emms-cache-set (type path track) - "Set PATH to TRACK in the cache." - (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...") - (set-buffer (get-buffer-create " emms-cache ")) - (erase-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)) - (write-region (point-min) (point-max) emms-cache-file) - (kill-buffer (current-buffer)) - (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 () - "Sync the cache with the data on disc. -Remove non-existent files, and update data for files which have -been modified." - (interactive) - (message "Syncing emms track cache...") - (let (removed) - (maphash (lambda (path track) - (when (eq (emms-track-get track 'type) 'file) - ;; 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)) - (run-hook-with-args 'emms-info-functions track)))))) - emms-cache-db) - (when removed - (setq emms-cache-dirty t))) - (message "Syncing emms track cache...done")) - -(provide 'emms-cache) -;;; emms-cache.el ends here diff --git a/emms-compat.el b/emms-compat.el deleted file mode 100644 index 74ecb48..0000000 --- a/emms-compat.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; emms-compat.el --- Compatibility routines for EMMS - -;; Copyright (C) 2005, 2006, 2007 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." - (condition-case nil - (make-obsolete old-name new-name when) - (wrong-number-of-arguments (make-obsolete old-name new-name)))) - - -;;; 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))))) - - -;;; 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/emms-history.el b/emms-history.el deleted file mode 100644 index 47d2e73..0000000 --- a/emms-history.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; emms-history.el -- save all playlists when exiting emacs - -;; Copyright (C) 2006, 2007 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) -(eval-when-compile - (require 'cl)) - -(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 - :group 'emms-history) - -(defcustom emms-history-start-playing nil - "If non-nil emms starts playing the current track after -`emms-history-load' was invoked." - :type 'boolean - :group 'emms-history) - -(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 "(\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)))))) - -(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 - (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)) - (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/emms-i18n.el b/emms-i18n.el deleted file mode 100644 index ac54eff..0000000 --- a/emms-i18n.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; emms-i18n.el --- Function for handling coding system - -;; Copyright (C) 2006, 2007 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 read from process, first check the CAR part of -;; `emms-i18n-default-coding-system', if non-nil, use this for decode, and -;; nerver detect coding system, if nil, first call -;; `emms-i18n-coding-dectect-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-nerver-used-coding-system', decode it, otherwise use -;; locale-coding-system. -;; -;; When write send 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) -(eval-when-compile - (require 'cl)) - -;; TODO: Change these to use defcustom - -(defvar emms-i18n-nerver-used-coding-system - '(raw-text undecided) - "If the `emms-i18n-coding-dectect-functions' return coding system in -this list, use `emms-i18n-default-coding-system' instead.") - -(defvar emms-i18n-coding-system-for-read 'utf-8 - "If coding detect failed, use this for decode") - -(defvar emms-i18n-default-coding-system nil - "If non-nil, used for decode and encode") - -(defvar emms-i18n-coding-dectect-functions nil - "A list of function to call to detect codings") - -(defvar emms-i18n-detect-max-size 10000 - "Max bytes to detect coding system. Nil mean scan whole buffer.") - -(defun emms-i18n-iconv (from to str) - "Convert 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) - (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 read is %S." (car emms-i18n-default-coding-system)) - "Good, you want detect coding system by me!") - (format " The coding system for write is %S." - (or (cdr emms-i18n-default-coding-system) - (cdr default-process-coding-system)))))) - -(defun emms-i18n-call-process-simple (&rest args) - "This function run program and return the program result. If the CAR -part of `emms-i18n-default-coding-system' is non-nil, the program result will -be decode use the CAR part of emms-i18n-default-coding-system. Otherwise, -use `emms-i18n-coding-dectect-functions' to detect the coding system of the -result. If the emms-i18n-coding-dectect-functions failed, use -`emms-i18n-detect-coding-function' to detect coding system. If all the -coding system is nil or in `emms-i18n-nerver-used-coding-system', decode -the result using `emms-i18n-coding-system-for-read'. - -The rest arguments ARGS is as the same as `call-process', except the -BUFFER should always have value t. Otherwise the coding detection will -not perform." - (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) - (null (car emms-i18n-default-coding-system))) - (save-restriction - (narrow-to-region pos (point)) - (decode-coding-region (point-min) (point-max) (emms-i18n-detect-buffer-coding-system)))) - exit)) - -;; Is this function useful? -(defun emms-i18n-call-process (&rest args) - "Run the program like `call-process'. If -the cdr part `emms-i18n-default-coding-system' is non-nil, the string in -ARGS will be encode by the CDR part of `emms-i18n-default-coding-system', -otherwise, it is pass all parameter 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 call this function, make sure the buffer is literal" - (let ((size (- (point-max) (point-min))) - (func (append emms-i18n-coding-dectect-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-nerver-used-coding-system) - (setq coding (emms-i18n-detect-coding-function size)))) - (if (or (null coding) (member (coding-system-base coding) emms-i18n-nerver-used-coding-system)) - emms-i18n-coding-system-for-read - coding)))) - -;;; emms-i18n.el ends here diff --git a/emms-info-libtag.el b/emms-info-libtag.el deleted file mode 100644 index 96c7613..0000000 --- a/emms-info-libtag.el +++ /dev/null @@ -1,81 +0,0 @@ -;;; emms-info-libtag.el --- Info-method for EMMS using libtag - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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-to-list '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)) - -;;; Code: - -(require 'emms-info) - -(defvar emms-info-libtag-coding-system 'utf-8) -(defvar emms-info-libtag-program-name "emms-print-metadata") - -(defun emms-info-libtag (track) - (when (and (eq 'file (emms-track-type track)) - (string-match - "\\.\\([Mm][Pp]3\\|[oO][gG][gG]\\|[fF][lL][aA][cC]\\|[sS][pP][xX]\\)\\'" - (emms-track-name track))) - (with-temp-buffer - (when (zerop - (let ((coding-system-for-read 'utf-8)) - (call-process "emms-print-metadata" - nil t 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/emms-info-metaflac.el b/emms-info-metaflac.el deleted file mode 100644 index fe94db0..0000000 --- a/emms-info-metaflac.el +++ /dev/null @@ -1,107 +0,0 @@ -;;; emms-info-metaflac.el --- Info-method for EMMS using metaflac - -;; Copyright (C) 2006 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-to-list 'emms-info-methods-list 'emms-info-metaflac) - -;;; Code: - -(eval-when-compile (require 'cl)) -(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 - :group 'emms-info-metaflac) - -(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=GENRE") - "The argument to pass to `emms-info-metaflac-program-name'." - :type '(repeat string) - :group 'emms-info-metaflac) - -(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 (eq 'file (emms-track-type 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/emms-info-mp3info.el b/emms-info-mp3info.el deleted file mode 100644 index b1345cd..0000000 --- a/emms-info-mp3info.el +++ /dev/null @@ -1,103 +0,0 @@ -;;; emms-info-mp3info.el --- Info-method for EMMS using mp3info - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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 - :group 'emms-info-mp3info) - -(defcustom emms-info-mp3info-program-name "mp3info" - "*The name/path of the mp3info tag program." - :type 'string - :group 'emms-info-mp3info) - -(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) - :group 'emms-info-mp3info) - -(defun emms-info-mp3info (track) - "Add track information to TRACK. -This is a useful element for `emms-info-functions'." - (when (and (eq 'file (emms-track-type 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/emms-info-ogg.el b/emms-info-ogg.el deleted file mode 100644 index 035a8c6..0000000 --- a/emms-info-ogg.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; emms-info-ogg.el --- ogg-comment.el info-interface for EMMS - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. - -;; Authors: Yoni Rabkin , -;; Ulrik Jensen - -;; Keywords: ogg, emms, info - -;; 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 an interface to retrieving comments from -;; ogg-files, using Lawrence Mitchells ogg-comment.el. - -;; To activate, put something like this in your ~/.emacs: - -;; (require 'emms-info-ogg) -;; (add-to-list 'emms-info-methods-list 'emms-info-ogg) - -;; You'll of course need to also have a player if you want to actually -;; play the files. - -;;; Code: - -(require 'emms-info) -(require 'ogg-comment) - -(defvar emms-info-ogg-version "0.2 $Revision: 1.14 $" - "EMMS info ogg version string.") -;; $Id: emms-info-ogg.el,v 1.14 2005/07/09 11:56:00 forcer Exp $ - -(defgroup emms-info-ogg nil - "An EMMS-info method for getting/setting ogg-comments, using -ogg-comments.el" - :group 'emms-info-methods - :prefix "emms-info-ogg-") - -(defun emms-info-ogg-get-comment (field info) - (let ((comment (cadr (assoc field (cadr info))))) - (if comment - comment - ""))) - -(defun emms-info-ogg (track) - "Retrieve an emms-info structure as an ogg-comment" - (when (and (eq 'file (emms-track-type track)) - (string-match "\\.[Oo][Gg][Gg]\\'" (emms-track-name track))) - (let ((info (oggc-read-header (emms-track-name track))) - (file (emms-track-get track 'name)) - ptime-total ptime-min ptime-sec) - (with-temp-buffer - (call-process "ogginfo" nil t nil file) - (goto-char (point-min)) - (re-search-forward "Playback length: \\([0-9]*\\)m:\\([0-9]*\\)") - (let ((minutes (string-to-number (match-string 1))) - (seconds (string-to-number (match-string 2)))) - (setq ptime-total (+ (* minutes 60) seconds) - ptime-min minutes - ptime-sec seconds))) - - (emms-track-set track 'info-title (emms-info-ogg-get-comment "title" info)) - (emms-track-set track 'info-artist (emms-info-ogg-get-comment "artist" info)) - (emms-track-set track 'info-composer (emms-info-ogg-get-comment "composer" info)) - (emms-track-set track 'info-performer (emms-info-ogg-get-comment "performer" info)) - (emms-track-set track 'info-album (emms-info-ogg-get-comment "album" info)) - (emms-track-set track 'info-note (emms-info-ogg-get-comment "comment" info)) - (emms-track-set track 'info-year (emms-info-ogg-get-comment "date" info)) - (emms-track-set track 'info-genre (emms-info-ogg-get-comment "genre" info)) - (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))))) - -(provide 'emms-info-ogg) -;;; emms-info-ogg.el ends here diff --git a/emms-info-ogginfo.el b/emms-info-ogginfo.el deleted file mode 100644 index e59b70a..0000000 --- a/emms-info-ogginfo.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; emms-info-ogginfo.el --- Emms information from Ogg Vorbis files. - -;; Copyright (C) 2005, 2006, 2007 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 - :group 'emms-info-ogginfo) - -(defcustom emms-info-ogginfo-program-name "ogginfo" - "*The name/path of the ogginfo tag program." - :type 'string - :group 'emms-info-ogginfo) - -(defun emms-info-ogginfo (track) - "Add track information to TRACK. -This is a useful element for `emms-info-functions'." - (when (and (eq 'file (emms-track-type 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))) - (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/emms-info.el b/emms-info.el deleted file mode 100644 index d60edb9..0000000 --- a/emms-info.el +++ /dev/null @@ -1,135 +0,0 @@ -;;; emms-info.el --- Retrieving track information - -;; Copyright (C) 2005, 2006, 2007 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-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 '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 - :group 'emms-info) - -(defcustom emms-info-asynchronously t - "*Non-nil when track information should be loaded asynchronously. -This requires `later-do', which should come with EMMS." - :type 'boolean - :group 'emms-info) - -(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 - :group 'emms-info) - -(defcustom emms-info-functions nil - "*Functions which add information to tracks. -Each is called with a track as argument." - :type 'hook - :group 'emms-info) - -(defvar emms-info-asynchronous-tracks 0 - "Number of tracks we're waiting for to be done.") - -(defun emms-info-initialize-track (track) - "Initialize TRACK with emms-info information. -This is a suitable value for `emms-track-initialize-functions'." - (if (not emms-info-asynchronously) - (emms-info-really-initialize-track track) - (setq emms-info-asynchronous-tracks (1+ emms-info-asynchronous-tracks)) - (later-do 'emms-info-really-initialize-track track))) - -(defun emms-info-really-initialize-track (track) - "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)) - (name (emms-track-get track 'name))) - - ;; 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)) - (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 the current track." - (let ((artist (emms-track-get track 'info-artist)) - (title (emms-track-get track 'info-title))) - (if (and artist title) - (format "%s - %s" artist title) - (emms-track-simple-description track)))) - -(provide 'emms-info) -;;; emms-info.el ends here diff --git a/emms-last-played.el b/emms-last-played.el deleted file mode 100644 index 1446de6..0000000 --- a/emms-last-played.el +++ /dev/null @@ -1,123 +0,0 @@ -;;; emms-last-played.el --- Support for last-played-time of a track - -;; Copyright (C) 2006, 2007 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 (time-to-seconds messy-date)) - (now (time-to-seconds (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)))) - (while (if (numberp top) (< top difference) (not top)) - (progn - (setq templist (cdr templist)) - (setq top (eval (caar templist))))) - (if (stringp (cdr (car templist))) - (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) (seconds-to-time messy-date))) - (error "Never."))) - -(provide 'emms-last-played) -;;; emms-last-played.el ends here diff --git a/emms-lastfm.el b/emms-lastfm.el deleted file mode 100644 index 1f597d7..0000000 --- a/emms-lastfm.el +++ /dev/null @@ -1,673 +0,0 @@ -;;; emms-lastfm.el --- add your listened songs to your profile at last.fm - -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. - -;; Author: Tassilo Horn - -;; 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 sends information about what music you are playing to last.fm. -;; See and -;; . - -;;; Sample configuration: - -;; (setq emms-lastfm-username "my-user-name" -;; emms-lastfm-password "very-secret!") - -;;; Usage: - -;; To activate the last.fm emms plugin, run: -;; `M-x emms-lastfm-enable' - -;; Now all music you listen to will be submitted to Last.fm to enhance your -;; profile. - -;; To deactivate the last.fm emms plugin, run: -;; `M-x emms-lastfm-disable' - -;; Beside submitting the tracks you listen to, you can also listen to Last.fm -;; radio. Simply copy the lastfm:// URL and run & paste: -;; `M-x emms-lastfm-radio RET lastfm://artist/Britney Spears/fans' -;; (Of course you don't need to use _this_ URL. :-)) - -;; You can also insert Last.fm streams into playlists (or use -;; emms-streams.el to listen to them) by activating the player as -;; follows. -;; (add-to-list 'emms-player-list 'emms-player-lastfm-radio) -;; To insert a Last.fm stream into a playlist, do -;; (emms-insert-lastfm "lastfm://rest-of-url") - -;; There are some functions for conveniently playing the Similar Artists and -;; the Global Tag Radio. Here you only need to enter the band's name or the tag -;; respectively. -;; `M-x emms-lastfm-radio-similar-artists RET Britney Spears' -;; `M-x emms-lastfm-radio-global-tag RET pop' - -;; When you're listening to a Last.fm radio station you have the possibility to -;; give feedback to them. If you like the current song, type -;; `M-x emms-lastfm-radio-love'. -;; If it's not that good, or it just happens to not fit to your actual mood, -;; type -;; `M-x emms-lastfm-radio-skip' -;; and this song will be skipped. -;; If you really hate that song and you never want to hear it again, ban it by -;; typing -;; `M-x emms-lastfm-radio-ban'. - -;;; TODO -;; -;; - Get the last.fm radio stuff right again. Currently the rating stuff seems -;; to be broken. There seems to be no official API, so one needs to look -;; into the sources of the official client which can be found at -;; http://www.audioscrobbler.net/development/client/. - -;; ----------------------------------------------------------------------- - -(require 'url) -(require 'emms) -(require 'emms-mode-line) -(require 'emms-playing-time) -(require 'emms-source-file) -(require 'emms-url) - -;;; Variables - -(defgroup emms-lastfm nil - "Interaction with the services offered by http://www.last.fm." - :prefix "emms-lastfm-" - :group 'emms) - -(defcustom emms-lastfm-username "" - "Your last.fm username" - :type 'string - :group 'emms-lastfm) - -(defcustom emms-lastfm-password "" - "Your last.fm password" - :type 'string - :group 'emms-lastfm) - -(defcustom emms-lastfm-submission-verbose-p nil - "If non-nil, display a message every time we submit a track to Last.fm." - :type 'boolean - :group 'emms-lastfm) - -(defcustom emms-lastfm-submit-track-types '(file) - "Specify what types of tracks to submit to Last.fm. -The default is to only submit files. - -To submit every track to Last.fm, set this to t. - -Note that it is not very meaningful to submit playlists, -streamlists, or Last.fm streams to Last.fm." - :type '(choice (const :tag "All" t) - (set :tag "Types" - (const :tag "Files" file) - (const :tag "URLs" url) - (const :tag "Playlists" playlist) - (const :tag "Streamlists" streamlist) - (const :tag "Last.fm streams" lastfm))) - :group 'emms-lastfm) - -(defconst emms-lastfm-server "http://post.audioscrobbler.com/" - "The last.fm server responsible for the handshaking -procedure. Only for internal use.") -(defconst emms-lastfm-client-id "ems" - "The client ID of EMMS. Don't change it!") -(defconst emms-lastfm-client-version 0.2 - "The version registered at last.fm. Don't change it!") -(defconst emms-lastfm-protocol-version 1.2 - "The version of the supported last.fm protocol. Don't change it.") - -;; used internally -(defvar emms-lastfm-process nil "-- only used internally --") -(defvar emms-lastfm-session-id nil "-- only used internally --") -(defvar emms-lastfm-now-playing-url nil "-- only used internally --") -(defvar emms-lastfm-submit-url nil "-- only used internally --") -(defvar emms-lastfm-current-track nil "-- only used internally --") -(defvar emms-lastfm-timer nil "-- only used internally --") -(defvar emms-lastfm-current-track-starting-time-string nil "-- only used internally --") - -;;; Scrobbling - -(defun emms-lastfm-new-track-function () - "This function should run whenever a new track starts (or a -paused track resumes) and sets the track submission timer." - (setq emms-lastfm-current-track - (emms-playlist-current-selected-track)) - (setq emms-lastfm-current-track-starting-time-string - (emms-lastfm-current-unix-time-string)) - ;; Tracks should be submitted, if they played 240 secs or half of their - ;; length, whichever comes first. - (let ((secs (emms-track-get emms-lastfm-current-track 'info-playing-time)) - (type (emms-track-type emms-lastfm-current-track))) - (when (and secs - (or (eq emms-lastfm-submit-track-types t) - (and (listp emms-lastfm-submit-track-types) - (memq type emms-lastfm-submit-track-types)))) - (when (> secs 240) - (setq secs 240)) - (unless (< secs 30) ;; Skip titles shorter than 30 seconds - (setq secs (- (/ secs 2) emms-playing-time)) - (unless (< secs 0) - (setq emms-lastfm-timer - (run-with-timer secs nil 'emms-lastfm-submit-track)))))) - ;; Update the now playing info displayed on the user's last.fm page. This - ;; doesn't affect the user's profile, so it can be done even for tracks that - ;; should not be submitted. - (emms-lastfm-submit-now-playing)) - -(defun emms-lastfm-http-POST (url string sentinel &optional sentinel-args) - "Perform a HTTP POST request to URL using STRING as data. -STRING will be encoded to utf8 before the request. Call SENTINEL -with the result buffer." - (let ((url-http-attempt-keepalives nil) - (url-show-status emms-lastfm-submission-verbose-p) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" - . "application/x-www-form-urlencoded; charset=utf-8"))) - (url-request-data (encode-coding-string string 'utf-8))) - (url-retrieve url sentinel sentinel-args))) - -(defun emms-lastfm-http-GET (url sentinel &optional sentinel-args) - "Perform a HTTP GET request to URL. -Call SENTINEL with SENTINEL-ARGS and the result buffer." - (let ((url-show-status emms-lastfm-submission-verbose-p) - (url-request-method "GET")) - (url-retrieve url sentinel sentinel-args))) - -(defun emms-lastfm-submit-now-playing () - "Submit now-playing infos to last.fm. -These will be displayed on the user's last.fm page." - (let* ((artist (emms-track-get emms-lastfm-current-track 'info-artist)) - (title (emms-track-get emms-lastfm-current-track 'info-title)) - (album (emms-track-get emms-lastfm-current-track 'info-album)) - (track-number (emms-track-get emms-lastfm-current-track - 'info-tracknumber)) - (musicbrainz-id "") - (track-length (number-to-string - (or (emms-track-get emms-lastfm-current-track - 'info-playing-time) - 0)))) - ;; wait up to 5 seconds to submit np infos in order to finish handshaking. - (dotimes (i 5) - (when (not (and emms-lastfm-session-id - emms-lastfm-now-playing-url)) - (sit-for 1))) - (when (and emms-lastfm-session-id - emms-lastfm-now-playing-url) - (emms-lastfm-http-POST emms-lastfm-now-playing-url - (concat "&s=" emms-lastfm-session-id - "&a[0]=" (emms-url-quote artist) - "&t[0]=" (emms-url-quote title) - "&b[0]=" (emms-url-quote album) - "&l[0]=" track-length - "&n[0]=" track-number - "&m[0]=" musicbrainz-id) - 'emms-lastfm-submit-now-playing-sentinel)))) - -(defun emms-lastfm-submit-now-playing-sentinel (&rest args) - "Parses the server reponse and inform the user if all worked -well or if an error occured." - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (goto-char (point-min)) - ;; skip to the first empty line and go one line further. There the last.fm - ;; response starts. - (re-search-forward "^$" nil t) - (forward-line) - (if (re-search-forward "^OK$" nil t) - (progn - (when emms-lastfm-submission-verbose-p - (message "EMMS: Now playing infos submitted to last.fm")) - (kill-buffer buffer)) - (message "EMMS: Now playing infos couldn't be submitted to last.fm: %s" - (emms-read-line))))) - -(defun emms-lastfm-cancel-timer () - "Cancels `emms-lastfm-timer' if it is running." - (emms-cancel-timer emms-lastfm-timer) - (setq emms-lastfm-timer nil)) - -(defun emms-lastfm-pause () - "Handles things to be done when the player is paused or -resumed." - (if emms-player-paused-p - ;; the player paused - (emms-lastfm-cancel-timer) - ;; The player resumed - (emms-lastfm-new-track-function))) - -(defun emms-lastfm (&optional ARG) - "Start submitting the tracks you listened to to -http://www.last.fm, if ARG is positive. If ARG is negative or -zero submission of the tracks will be stopped. This applies to -the current track, too." - (interactive "p") - (cond - ((not (and emms-lastfm-username emms-lastfm-password)) - (message "%s" - (concat "EMMS: In order to activate the last.fm plugin you " - "first have to set both `emms-lastfm-username' and " - "`emms-lastfm-password'"))) - ((not emms-playing-time-p) - (message "%s" - (concat "EMMS: The last.fm plugin needs the functionality " - "provided by `emms-playing-time'. It seems that you " - "disabled it explicitly in your init file using code " - "like this: `(emms-playing-time -1)'. Delete that " - "line and have a look at `emms-playing-time's doc " - "string"))) - (t - (if (and ARG (> ARG 0)) - (progn - ;; Append it. Else the playing time could be started a bit too late. - (add-hook 'emms-player-started-hook - 'emms-lastfm-handshake-if-needed t) - ;; Has to be appended, because it has to run after - ;; `emms-playing-time-start' - (add-hook 'emms-player-started-hook - 'emms-lastfm-new-track-function t) - (add-hook 'emms-player-stopped-hook - 'emms-lastfm-cancel-timer) - (add-hook 'emms-player-paused-hook - 'emms-lastfm-pause) - (message "EMMS Last.fm plugin activated")) - (remove-hook 'emms-player-started-hook - 'emms-lastfm-handshake-if-needed) - (remove-hook 'emms-player-started-hook - 'emms-lastfm-new-track-function) - (remove-hook 'emms-player-stopped-hook - 'emms-lastfm-cancel-timer) - (remove-hook 'emms-player-paused-hook - 'emms-lastfm-pause) - (when emms-lastfm-timer (emms-cancel-timer emms-lastfm-timer)) - (setq emms-lastfm-session-id nil - emms-lastfm-submit-url nil - emms-lastfm-process nil - emms-lastfm-current-track nil) - (message "EMMS Last.fm plugin deactivated"))))) - -(defalias 'emms-lastfm-activate 'emms-lastfm) -(emms-make-obsolete 'emms-lastfm-activate 'emms-lastfm "EMMS 2.2") - -(defun emms-lastfm-enable () - "Enable the emms last.fm plugin." - (interactive) - (emms-lastfm 1)) - -(defun emms-lastfm-disable () - "Disable the emms last.fm plugin." - (interactive) - (emms-lastfm -1)) - -(defun emms-lastfm-restart () - "Disable and reenable the last.fm plugin. This will cause a new -handshake." - (emms-lastfm-disable) - (emms-lastfm-enable)) - -(defun emms-lastfm-handshake-if-needed () - (when (not (and emms-lastfm-session-id - emms-lastfm-submit-url - emms-lastfm-now-playing-url)) - (emms-lastfm-handshake))) - -(defun emms-lastfm-current-unix-time-string () - (replace-regexp-in-string "\\..*" "" (number-to-string (float-time)))) - -(defun emms-lastfm-handshake () - "Handshakes with the last.fm server." - (let ((timestamp (emms-lastfm-current-unix-time-string))) - (emms-lastfm-http-GET - (concat emms-lastfm-server - "?hs=true" - "&p=" (number-to-string emms-lastfm-protocol-version) - "&c=" emms-lastfm-client-id - "&v=" (number-to-string emms-lastfm-client-version) - "&u=" (emms-url-quote emms-lastfm-username) - "&t=" timestamp - "&a=" (md5 (concat (md5 emms-lastfm-password) timestamp))) - 'emms-lastfm-handshake-sentinel))) - -(defun emms-lastfm-handshake-sentinel (&rest args) - "Parses the server reponse and inform the user if all worked -well or if an error occured." - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (goto-char (point-min)) - ;; skip to the first empty line and go one line further. There the last.fm - ;; response starts. - (re-search-forward "^$" nil t) - (forward-line) - (let ((response (emms-read-line))) - (if (not (string-match (rx (or "OK")) response)) - (message "EMMS: Handshake failed: %s" response) - (forward-line) - (setq emms-lastfm-session-id (emms-read-line)) - (forward-line) - (setq emms-lastfm-now-playing-url (emms-read-line)) - (forward-line) - (setq emms-lastfm-submit-url (emms-read-line)) - (message "EMMS: Handshaking with server done") - (kill-buffer buffer))))) - -(defun emms-lastfm-submit-track () - "Submits the current track (`emms-lastfm-current-track') to -last.fm." - (let* ((artist (emms-track-get emms-lastfm-current-track 'info-artist)) - (title (emms-track-get emms-lastfm-current-track 'info-title)) - (album (emms-track-get emms-lastfm-current-track 'info-album)) - (track-number (emms-track-get emms-lastfm-current-track 'info-tracknumber)) - (musicbrainz-id "") - (track-length (number-to-string - (emms-track-get emms-lastfm-current-track - 'info-playing-time)))) - (emms-lastfm-http-POST - emms-lastfm-submit-url - (concat "&s=" emms-lastfm-session-id - "&a[0]=" (emms-url-quote artist) - "&t[0]=" (emms-url-quote title) - "&i[0]=" emms-lastfm-current-track-starting-time-string - "&o[0]=P" ;; TODO: Maybe support others. See the API. - "&r[0]=" ;; The rating. Empty if not applicable (for P it's not) - "&l[0]=" track-length - "&b[0]=" (emms-url-quote album) - "&n[0]=" track-number - "&m[0]=" musicbrainz-id) - 'emms-lastfm-submission-sentinel))) - -(defun emms-lastfm-submission-sentinel (&rest args) - "Parses the server reponse and inform the user if all worked -well or if an error occured." - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (goto-char (point-min)) - ;; skip to the first empty line and go one line further. There the last.fm - ;; response starts. - (re-search-forward "^$" nil t) - (forward-line) - (if (re-search-forward "^OK$" nil t) - (progn - (when emms-lastfm-submission-verbose-p - (message "EMMS: \"%s\" submitted to last.fm" - (emms-track-description emms-lastfm-current-track))) - (kill-buffer buffer)) - (message "EMMS: Song couldn't be submitted to last.fm: %s" - (emms-read-line))))) - -;;; Playback of lastfm:// streams - -(defgroup emms-player-lastfm-radio nil - "EMMS player for Last.fm streams." - :group 'emms-player - :prefix "emms-player-lastfm-") - -(defcustom emms-player-lastfm-radio (emms-player 'emms-lastfm-radio-start - 'ignore ; no need to stop - 'emms-lastfm-radio-playable-p) - "*Parameters for the Last.fm radio player." - :type '(cons symbol alist) - :group 'emms-player-lastfm-radio) - -(defconst emms-lastfm-radio-base-url "http://ws.audioscrobbler.com/radio/" - "The base URL for playing lastfm:// stream. --- only used internally --") - -(defvar emms-lastfm-radio-session nil "-- only used internally --") -(defvar emms-lastfm-radio-stream-url nil "-- only used internally --") - -(defun emms-lastfm-radio-get-handshake-url () - (concat emms-lastfm-radio-base-url - "handshake.php?version=" (number-to-string - emms-lastfm-client-version) - "&platform=" emms-lastfm-client-id - "&username=" (emms-url-quote emms-lastfm-username) - "&passwordmd5=" (md5 emms-lastfm-password) - "&debug=" (number-to-string 9))) - -(defun emms-lastfm-radio-handshake (fn radio-url) - "Handshakes with the last.fm server. -Calls FN when done with RADIO-URL as its only argument." - (emms-lastfm-http-GET (emms-lastfm-radio-get-handshake-url) - 'emms-lastfm-radio-handshake-sentinel - (list fn radio-url))) - -(defun emms-lastfm-radio-handshake-sentinel (status fn radio-url) - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (setq emms-lastfm-radio-session (emms-key-value "session")) - (setq emms-lastfm-radio-stream-url (emms-key-value "stream_url")) - (kill-buffer buffer) - (if (and emms-lastfm-radio-session emms-lastfm-radio-stream-url) - (progn - (message "EMMS: Handshaking for Last.fm playback successful") - (funcall fn radio-url)) - (message "EMMS: Failed handshaking for Last.fm playback")))) - -(defun emms-lastfm-radio-1 (lastfm-url) - "Internal function used by `emms-lastfm-radio'." - (if (and emms-lastfm-radio-session - emms-lastfm-radio-stream-url) - (progn - (emms-lastfm-http-GET - (concat emms-lastfm-radio-base-url - "adjust.php?" - "session=" emms-lastfm-radio-session - "&url=" (emms-url-quote lastfm-url) - "&debug=" (number-to-string 0)) - 'emms-lastfm-radio-sentinel)) - (message "EMMS: Cannot play Last.fm stream"))) - -(defun emms-lastfm-radio (lastfm-url) - "Plays the stream associated with the given Last.fm URL. (A -Last.fm URL has the form lastfm://foo/bar/baz, e.g. - - lastfm://artist/Manowar/similarartists - -or - - lastfm://globaltags/metal." - (interactive "sLast.fm URL: ") - ;; Streamed songs must not be added to the lastfm profile - (emms-lastfm-disable) - (if (not (and emms-lastfm-radio-session - emms-lastfm-radio-stream-url)) - (emms-lastfm-radio-handshake #'emms-lastfm-radio-1 lastfm-url) - (emms-lastfm-radio-1 lastfm-url))) - -(defun emms-lastfm-radio-playable-p (track) - "Determine whether the Last.fm player can play this track." - (let ((name (emms-track-get track 'name)) - (type (emms-track-get track 'type))) - (and (eq type 'lastfm) - (string-match "^lastfm://" name)))) - -(defun emms-lastfm-radio-start (track) - "Start playing TRACK." - (when (emms-lastfm-radio-playable-p track) - (let ((name (emms-track-get track 'name))) - (emms-lastfm-radio name)))) - -(defcustom emms-lastfm-radio-metadata-period 15 - "When listening to Last.fm Radio every how many seconds should -emms-lastfm poll for metadata? If set to nil, there won't be any -polling at all. - -The default is 15: That means that the mode line will display the -wrong (last) track's data for a maximum of 15 seconds. If your -network connection has a big latency this value may be too -high. (But then streaming a 128KHz mp3 won't be fun anyway.)" - :type '(choice integer - (const :tag "Disable" nil)) - :group 'emms-lastfm) - -(defun emms-lastfm-radio-sentinel (&rest args) - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (if (string= (emms-key-value "response" buffer) "OK") - (progn - (kill-buffer buffer) - (emms-play-url emms-lastfm-radio-stream-url) - (when emms-lastfm-radio-metadata-period - (setq emms-lastfm-timer - (run-with-timer 0 emms-lastfm-radio-metadata-period - 'emms-lastfm-radio-request-metadata)) - (add-hook 'emms-player-stopped-hook - 'emms-lastfm-cancel-timer)) - (message "EMMS: Playing Last.fm stream")) - (kill-buffer buffer) - (message "EMMS: Bad response from Last.fm")))) - -(defun emms-lastfm-np (&optional insertp callback) - "Show the currently-playing lastfm radio tune. - -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." - (interactive "P") - (emms-lastfm-radio-request-metadata - (lambda (status insertp buffer callback) - (let ((response-buf (current-buffer)) - artist title) - (emms-http-decode-buffer response-buf) - (setq artist (emms-key-value "artist" response-buf) - title (emms-key-value "track" response-buf)) - (kill-buffer response-buf) - (let ((msg (if (and title artist) - (format emms-show-format - (format "%s - %s" artist title)) - "Nothing playing right now"))) - (cond ((functionp callback) - (when (and title artist) - (funcall callback buffer msg))) - ((and insertp title artist) - (with-current-buffer buffer - (insert msg))) - (t (message msg)))))) - (list insertp (current-buffer) callback))) - -(defun emms-lastfm-radio-similar-artists (artist) - "Plays the similar artist radio of ARTIST." - (interactive "sArtist: ") - (emms-lastfm-radio (concat "lastfm://artist/" - artist - "/similarartists"))) - -(defun emms-lastfm-radio-global-tag (tag) - "Plays the global tag radio of TAG." - (interactive "sGlobal Tag: ") - (emms-lastfm-radio (concat "lastfm://globaltags/" tag))) - -(defun emms-lastfm-radio-artist-fan (artist) - "Plays the artist fan radio of ARTIST." - (interactive "sArtist: ") - (emms-lastfm-radio (concat "lastfm://artist/" artist "/fans"))) - -(defun emms-lastfm-radio-love () - "Inform Last.fm that you love the currently playing song." - (interactive) - (emms-lastfm-radio-rating "love")) - -(defun emms-lastfm-radio-skip () - "Inform Last.fm that you want to skip the currently playing -song." - (interactive) - (emms-lastfm-radio-rating "skip")) - -(defun emms-lastfm-radio-ban () - "Inform Last.fm that you want to ban the currently playing -song." - (interactive) - (emms-lastfm-radio-rating "ban")) - -(defun emms-lastfm-radio-rating (command) - (emms-lastfm-http-GET - (concat emms-lastfm-radio-base-url - "control.php?" - "session=" emms-lastfm-radio-session - "&command=" command - "&debug=" (number-to-string 0)) - 'emms-lastfm-radio-rating-sentinel)) - -(defun emms-lastfm-radio-rating-sentinel (&rest args) - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (if (string= (emms-key-value "response" buffer) "OK") - (message "EMMS: Rated current track") - (message "EMMS: Rating failed")) - (kill-buffer buffer))) - -(defun emms-lastfm-radio-request-metadata (&optional fn data) - "Request the metadata of the current song and display it. - -If FN is given, call it instead of -`emms-lastfm-radio-request-metadata-sentinel', with DATA as its -first parameter. - -If DATA is given, it should be a list." - (interactive) - (emms-lastfm-http-GET - (concat emms-lastfm-radio-base-url - "np.php?" - "session=" emms-lastfm-radio-session - "&debug=" (number-to-string 0)) - (or fn 'emms-lastfm-radio-request-metadata-sentinel) - data)) - -(defun emms-lastfm-radio-request-metadata-sentinel (&rest args) - (let ((buffer (current-buffer))) - (emms-http-decode-buffer buffer) - (let ((artist (emms-key-value "artist" buffer)) - (title (emms-key-value "track" buffer)) - (track (emms-playlist-current-selected-track))) - (kill-buffer buffer) - (emms-track-set track 'info-artist artist) - (emms-track-set track 'info-title title) - (emms-track-updated track)))) - - -;;; Utility functions - -(defun emms-read-line () - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))) - -(defun emms-key-value (key &optional buffer) - "Returns the value of KEY from BUFFER. -If BUFFER is nil, use the current buffer. - -BUFFER has to contain a key-value list like: - -foo=bar -x=17" - (unless (and buffer (not (buffer-live-p buffer))) - (with-current-buffer (or buffer (current-buffer)) - (goto-char (point-min)) - (when (re-search-forward (concat "^" key "=") nil t) - (buffer-substring-no-properties (point) (line-end-position)))))) - -(provide 'emms-lastfm) -;;; emms-lastfm.el ends here diff --git a/emms-lyrics.el b/emms-lyrics.el deleted file mode 100644 index dfcc7a8..0000000 --- a/emms-lyrics.el +++ /dev/null @@ -1,520 +0,0 @@ -;;; emms-lyrics.el --- Display lyrics synchronically - -;; Copyright (C) 2005, 2006, 2007, 2008 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) - -;;; 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 - :group 'emms-lyrics) - -(defcustom emms-lyrics-display-on-minibuffer nil - "If non-nil, display lyrics on minibuffer." - :type 'boolean - :group 'emms-lyrics) - -(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 - :group 'emms-lyrics) - -(defcustom emms-lyrics-display-format " %s " - "Format for displaying lyrics." - :type 'string - :group 'emms-lyrics) - -(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 - :group 'emms-lyrics) - -(defcustom emms-lyrics-mode-hook nil - "Normal hook run after entering Emms Lyric mode." - :type 'hook - :group 'emms-lyrics) - -(defcustom emms-lyrics-find-lyric-function 'emms-lyrics-find-lyric - "Function for finding lyric files." - :type 'symbol - :group 'emms-lyrics) - -(defcustom emms-lyrics-scroll-p t - "Non-nil value will enable lyrics scrolling." - :type 'boolean - :group 'emms-lyrics) - -(defcustom emms-lyrics-scroll-timer-interval 0.4 - "Interval between scroller timers. The shorter, the faster." - :type 'number - :group 'emms-lyrics) - - -;;; User Interfaces - -(defvar emms-lyrics-display-p t - "If non-nil, will diplay lyrics.") - -(defvar emms-lyrics-mode-line-string "" - "Current lyric.") - -;;;###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 (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, search it from internet...") - (let ((title (emms-track-get track 'title)) - (filename (file-name-sans-extension - (file-name-nondirectory name))) - (url "")) - (unless title - (setq title filename)) - (cond ((string-match "\\cc" title) ; chinese lyrics - ;; Since tag info might be encoded using various coding - ;; systems, we'd better fall back on filename. - (setq url (format - "http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word=%s&lm=-1" - (emms-url-quote-plus - (encode-coding-string filename 'gb2312))))) - (t ; english lyrics - (setq url (format "http://search.lyrics.astraweb.com/?word=%s" - ;;"http://www.lyrics007.com/cgi-bin/s.cgi?q=" - (emms-url-quote-plus title))))) - (browse-url url) - (message "lyric file does not exist, search it from internet...done"))))) - - -;;; 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)) - (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-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)))) - (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 - (time-to-seconds (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 - (+ (time-to-seconds - (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 - (time-to-seconds (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)) - (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 emms-lyrics-timers - (append emms-lyrics-timers - (list - (run-at-time (format "%d sec" time) - nil - 'emms-lyrics-display-handler - lyric - next-lyric - (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 diff) - "DIFF is the timestamp differences between current LYRIC and -NEXT-LYRIC." - (emms-lyrics-display (format emms-lyrics-display-format lyric)) - (when emms-lyrics-scroll-p - (emms-lyrics-scroll lyric next-lyric diff))) - -(defun emms-lyrics-display (lyric) - "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))))) - -(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)))))) - (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 (+ (time-to-seconds - (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/emms-maint.el b/emms-maint.el deleted file mode 100644 index f68f6bd..0000000 --- a/emms-maint.el +++ /dev/null @@ -1 +0,0 @@ -(add-to-list 'load-path ".") diff --git a/emms-mark.el b/emms-mark.el deleted file mode 100644 index d989078..0000000 --- a/emms-mark.el +++ /dev/null @@ -1,296 +0,0 @@ -;;; emms-mark.el --- mark track like dired - -;; Copyright (C) 2006, 2007 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 'emms) -(require 'emms-playlist-mode) -(eval-when-compile - (require 'cl)) - -;;{{{ set new description-function -(defun emms-mark-track-description (track) - "Return a description of the current track." - (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 - "Mark tracks matching: " - "Unmark 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 -(defconst 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 () - "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 - (setq emms-playlist-buffer-p t) - (unless (eq major-mode 'emms-playlist-mode) - (emms-playlist-mode)) - - ;; 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/emms-metaplaylist-mode.el b/emms-metaplaylist-mode.el deleted file mode 100644 index 4b59421..0000000 --- a/emms-metaplaylist-mode.el +++ /dev/null @@ -1,184 +0,0 @@ -;;; emms-metaplaylist-mode.el --- A major mode for lists of Emms -;;; playlists - -;; Copyright (C) 2006, 2007 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 Playlists*" - "*Name of the buffer in which Emms playlists will be listed." - :type 'string - :group 'emms-metaplaylist-mode) - -(defcustom emms-metaplaylist-mode-hooks nil - "*List of hooks to run on entry to emms-metaplaylist-mode." - :type 'list - :group 'emms-metaplaylist-mode) - -(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." - :group 'emms-metaplaylist-mode) - -(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." - :group 'emms-metaplaylist-mode) - -;;; -------------------------------------------------------- -;;; Keymap -;;; -------------------------------------------------------- - -(defconst 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 "q") 'kill-this-buffer) - (define-key map (kbd "?") 'describe-mode) - (define-key map (kbd "SPC") 'emms-metaplaylist-set-active) - (define-key map (kbd "c") 'emms-metaplaylist-new-buffer) - map) - "Keymap for `emms-metaplaylist-mode'.") - -;;; -------------------------------------------------------- -;;; Metaplaylist -;;; -------------------------------------------------------- - -(defun emms-metaplaylist-mode-goto-current () - "Switch to the buffer at point." - (interactive) - (switch-to-buffer - (buffer-substring (point-at-bol) - (point-at-eol)))) - -;; Since there will never be a significantly large amount of playlist -;; buffers co-existing at once, we allow ourselves not to keep -;; state. We regenerate the playlists buffer anew on demand. -(defun emms-metaplaylist-mode-create () - "Create or recreate the meta-playlist buffer." - (let ((name emms-metaplaylist-mode-buffer-name) - (playlists (emms-playlist-buffer-list))) - (if playlists - (progn - (condition-case nil - (kill-buffer name) - (error nil)) - (get-buffer-create name) - (with-current-buffer name - (emms-metaplaylist-mode) - (save-excursion - (mapc (lambda (buf) - (let ((inhibit-read-only t)) - (insert (buffer-name buf)) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'face - (if (eq buf emms-playlist-buffer) - 'emms-metaplaylist-mode-current-face - 'emms-metaplaylist-mode-face))) - (newline))) - playlists)) - (current-buffer))) ; return the buffer as lisp obj - (error "No Emms playlist buffers")))) - -;;; -------------------------------------------------------- -;;; Playlist Management : creation, deletion (?) -;;; -------------------------------------------------------- - -(defun emms-metaplaylist-new-buffer (buffer-name) - "Creates a new buffer called buffer-name, which will be ready -to host EMMS tracks." - (interactive "sBuffer Name: ") - (if(get-buffer buffer-name) - (error "Buffer must not exist.") - (let ((buf (get-buffer-create buffer-name))) - (with-current-buffer buf - (setq emms-playlist-buffer-p t))) - (message "Buffer created"))) - -(defun emms-metaplaylist-set-active () - (interactive) - (emms-playlist-set-playlist-buffer - (get-buffer (buffer-substring (point-at-bol) (point-at-eol)))) - (let ((ici (point))) - (emms-metaplaylist-mode-go) - (goto-char ici))) - -;;; -------------------------------------------------------- -;;; Mode entry -;;; -------------------------------------------------------- - -(defun emms-metaplaylist-mode-go () - "Single entry point to the metaplaylist interface." - (interactive) - (emms-metaplaylist-mode-create) - (switch-to-buffer emms-metaplaylist-mode-buffer-name)) - -(defun emms-metaplaylist-mode () - "A major mode for Emms playlists." -;; (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/emms-mode-line-icon.el b/emms-mode-line-icon.el deleted file mode 100644 index b6822f2..0000000 --- a/emms-mode-line-icon.el +++ /dev/null @@ -1,79 +0,0 @@ -;; emms-mode-line-icon.el --- show an icon in the Emacs mode-line - -;; Copyright (C) 2006, 2007 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-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 ]\"") - -(defvar emms-mode-line-icon-image-cache - `(image :type xpm :ascent center :data ,(concat "/* XPM */ -static char *note[] = { -/* width height num_colors chars_per_pixel */ -\" 10 11 2 1\", -/* colors */ -\". c " emms-mode-line-icon-color "\", -\"# c None s None\", -/* pixels */ -\"###...####\", -\"###.#...##\", -\"###.###...\", -\"###.#####.\", -\"###.#####.\", -\"#...#####.\", -\"....#####.\", -\"#..######.\", -\"#######...\", -\"######....\", -\"#######..#\"};"))) - - -(defun emms-mode-line-icon-function () - (concat " " - emms-mode-line-icon-before-format - (emms-propertize "NP:" 'display emms-mode-line-icon-image-cache) - (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/emms-mode-line.el b/emms-mode-line.el deleted file mode 100644 index f8cfec4..0000000 --- a/emms-mode-line.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; emms-mode-line.el --- Mode-Line and titlebar infos for emms - -;; Copyright (C) 2004, 2005, 2006, 2007 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) - :group 'emms-mode-line) - -(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) - :group 'emms-mode-line) - -(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)))) - -(defvar emms-mode-line-active-p nil - "If non-nil, emms mode line is active.") -(defvar emms-mode-line-string "") - -(defvar emms-mode-line-initial-titlebar frame-title-format) - -(defun emms-mode-line (arg) - "Turn on `emms-mode-line' if ARG is positive, off otherwise." - (interactive "p") - (or global-mode-string (setq global-mode-string '(""))) - (if (and arg (> arg 0)) - (progn - (setq emms-mode-line-active-p t) - (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))) - (setq emms-mode-line-active-p nil) - (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'." - (interactive) - (emms-mode-line 1) - (message "emms mode line enabled")) - -;;;###autoload -(defun emms-mode-line-disable () - "Turn off `emms-mode-line'." - (interactive) - (emms-mode-line -1) - (message "emms mode line disabled")) - -;;;###autoload -(defun emms-mode-line-toggle () - "Toggle `emms-mode-line'." - (interactive) - (if emms-mode-line-active-p - (emms-mode-line-disable) - (emms-mode-line-enable))) - -(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." - (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/emms-player-mpd.el b/emms-player-mpd.el deleted file mode 100644 index ba31df4..0000000 --- a/emms-player-mpd.el +++ /dev/null @@ -1,1198 +0,0 @@ -;;; emms-player-mpd.el --- MusicPD support for EMMS - -;; Copyright (C) 2005, 2006, 2007 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 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 'emms-player-simple) -(require 'emms-source-playlist) ; for emms-source-file-parse-playlist -(require 'tq) - -(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) - :group 'emms-player-mpd) - -(defcustom emms-player-mpd-music-directory nil - "The value of 'music_directory' in your MusicPD configuration file. - -You need this if your playlists use absolute file names, otherwise -leave it set to nil." - ;; 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) - :group 'emms-player-mpd) - -(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 (split-string (shell-command-to-string "mpd --version") - "\n")) - (found-start nil) - (supported nil)) - ;; Get supported formats - (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://\\|" - "\\.\\(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))) - :group 'emms-player-mpd) - -(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 - :group 'emms-player-mpd) - -(defcustom emms-player-mpd-server-name (or (getenv "MPD_HOST") "localhost") - "The MusicPD server that we should connect to." - :type 'string - :group 'emms-player-mpd) - -(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) - :group 'emms-player-mpd) - -(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) - :group 'emms-player-mpd) - -(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 or a floating point number. - -This is used only if `emms-player-mpd-sync-playlist' is non-nil" - :type 'number - :group 'emms-player-mpd) - -(defcustom emms-player-mpd-verbose nil - "Whether to provide notifications for server connection events -and errors." - :type 'boolean - :group 'emms-player-mpd) - -(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 - :group 'emms-player-mpd) - -(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-song 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)))))) - -;; Ignore a useless byte-compile warning -(eval-when-compile - (put 'process-kill-without-query 'byte-compile nil)) - -(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 - (funcall emms-player-mpd-connect-function "mpd" - nil - emms-player-mpd-server-name - emms-player-mpd-server-port)) - (set-process-sentinel emms-player-mpd-process - 'emms-player-mpd-sentinel) - (setq emms-player-mpd-queue - (tq-create emms-player-mpd-process)) - (if (fboundp 'set-process-query-on-exit-flag) - (set-process-query-on-exit-flag emms-player-mpd-process nil) - (process-kill-without-query emms-player-mpd-process)) - ;; 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 (assoc (car cell) alist) - (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) - (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) 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) 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) id))) - (emms-player-mpd-get-status-part closure callback "song" 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) 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) - (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) - "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." - (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)))) - (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 - (unless (emms-playlist-selected-track-at-p) - (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-1 (closure info) - (let ((song (emms-player-mpd-get-current-song nil #'ignore info)) - (status (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= status "stop") - (emms-player-mpd-disconnect t) - (if song - ;; a track remains: the user probably stopped MusicPD - ;; manually, so we'll stop EMMS completely - (let ((emms-player-stopped-p t)) - (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 - (emms-player-stopped))) - ((string= status "pause") - nil) - ((string= status "play") - (unless (or (null song) - (and (stringp emms-player-mpd-current-song) - (string= song emms-player-mpd-current-song))) - (let ((emms-player-stopped-p t)) - (emms-player-stopped)) - (emms-player-mpd-select-song emms-player-mpd-current-song song) - (setq emms-player-mpd-current-song song) - (emms-player-started 'emms-player-mpd) - (when time - (run-hook-with-args 'emms-player-time-set-functions - time)))))))) - -(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)) - (emms-player-mpd-send "clear" nil #'ignore)) - -;;; 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 - (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)) - ((eq type 'file) - (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." - (if id - (progn - (unless (stringp id) - (setq id (number-to-string id))) - (emms-player-mpd-send - (concat "play " id) - nil - (lambda (closure response) - (setq emms-player-mpd-current-song nil) - (setq emms-player-mpd-status-timer - (run-at-time t emms-player-mpd-check-interval - '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) - (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) - (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) - (emms-player-mpd-get-playlist-id - nil - #'emms-player-mpd-start-and-sync-1)))) - -(defun emms-player-mpd-connect-1 (closure info) - (setq emms-player-mpd-current-song 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) - (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) - (setq emms-player-mpd-current-song 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 (+ 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 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) - (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 "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 (eq 'file (emms-track-type track)) - (not (string-match "\\`http://" file))) - (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-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) - (message "Dumping MusicPD data to cache...processing") - (let ((info (emms-player-mpd-get-alists - (emms-player-mpd-parse-response response)))) - (dolist (track-info info) - (emms-cache-set-from-mpd-track track-info)) - (message "Dumping MusicPD data to cache...done"))))) - (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) - (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 "")) - -(provide 'emms-player-mpd) - -;;; emms-player-mpd.el ends here diff --git a/emms-player-mpg321-remote.el b/emms-player-mpg321-remote.el deleted file mode 100644 index 6022093..0000000 --- a/emms-player-mpg321-remote.el +++ /dev/null @@ -1,222 +0,0 @@ -;;; emms-player-mpg321-remote.el --- play files with mpg321 -R - -;; Copyright (C) 2006, 2007 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 - :group 'emms-player-mpg321-remote) - -(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) - :group 'emms-player-mpg321-remote) - -(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) - :group 'emms-player-mpg321-remote) - -(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" - (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) - (let* ((data-lines (split-string str "\n" t)) - data line cmd) - (dolist (line data-lines) - (setq data (split-string line)) - (setq cmd (car data)) - (cond - ;; stop notice - ((and (string= cmd "@P") - (string= (cadr data) "0")) - (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)) - -(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/emms-player-mplayer.el b/emms-player-mplayer.el deleted file mode 100644 index c8bf466..0000000 --- a/emms-player-mplayer.el +++ /dev/null @@ -1,83 +0,0 @@ -;;; emms-player-mplayer.el --- mplayer support for EMMS - -;; Copyright (C) 2005, 2006, 2007, 2008 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) - (mapconcat 'regexp-quote - '(".ogg" ".mp3" ".wav" ".mpg" ".mpeg" ".wmv" ".wma" - ".mov" ".avi" ".divx" ".ogm" ".asf" ".mkv" "http://" "mms://" - ".rm" ".rmvb" ".mp4" ".flac" ".vob" ".m4a" ".ape") - "\\|") - "mplayer" "-slave" "-quiet" "-really-quiet") - -(define-emms-simple-player mplayer-playlist '(streamlist) - "http://" - "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/emms-player-simple.el b/emms-player-simple.el deleted file mode 100644 index 6286504..0000000 --- a/emms-player-simple.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; emms-player-simple.el --- A generic simple player. - -;; Copyright (C) 2003, 2004, 2006, 2007 Free Software Foundation, Inc. - -;; Authors: Ulrik Jensen -;; Jorgen Schäfer -;; Keywords: emms, mpg321, ogg123, mplayer - -;; 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 -;; emms-player-mplayer - -;;; 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 arguement -to call the player and ARGS are the command line arguements." - (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 - :group ',group) - (defcustom ,parameters ',args - ,(concat "*The arguments to `" (symbol-name command-name) "'.") - :type '(repeat string) - :group ',group) - (defcustom ,player-name (emms-player ',start ',stop ',playablep) - ,(concat "*A player for EMMS.") - :type '(cons symbol alist) - :group ',group) - (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" - (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 gstreamer '(file) - (emms-player-simple-regexp "mp3" "ogg" "mod" "flac" "xm" "it" "ft") - "gst-wrapper" "alsasink") -(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) - (emms-player-simple-regexp ".ogg" ".mp3" ".wav" ".flac" ".pls" ".m3u" "http://") - "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/emms-player-xine.el b/emms-player-xine.el deleted file mode 100644 index 715dec9..0000000 --- a/emms-player-xine.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; emms-player-xine.el --- xine support for EMMS - -;; Copyright (C) 2007 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) - (mapconcat 'regexp-quote - '(".ogg" ".mp3" ".wav" ".mpg" ".mpeg" ".wmv" ".wma" - ".mov" ".avi" ".divx" ".ogm" ".asf" ".mkv" "http://" "mms://" - ".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/emms-playing-time.el b/emms-playing-time.el deleted file mode 100644 index 18da082..0000000 --- a/emms-playing-time.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; emms-playing-time.el --- Display emms playing time on mode line - -;; Copyright (C) 2005, 2006, 2007 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. - -;;; 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: - -(eval-when-compile (require 'cl)) -(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 - :group 'emms-playing-time) - -(defcustom emms-playing-time-display-format " %s " - "Format used for displaying playing time." - :type 'string - :group 'emms-playing-time) - -(defcustom emms-playing-time-style 'time - "Style used for displaying playing time. -Valid styles are `time' (e.g., 01:30/4:20) and `bar' (e.g., [===> ])." - :type 'symbol - :group 'emms-playing-time) - - -;;; Emms Playing Time - -(defvar emms-playing-time-display-p nil - "Whether to display playing time on mode line or not") - -(defvar emms-playing-time 0 - "Time elapsed in current track.") - -(defvar emms-playing-time-string "") - -(defvar emms-playing-time-display-timer nil) - -(defvar emms-playing-time-p nil - "Whether emms-playing-time module is enabled or not") - -(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) - "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'." - (if (and arg (> arg 0)) - (progn - (setq emms-playing-time-p t - emms-playing-time-display-p 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-p nil - emms-playing-time-display-p 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 -(defun emms-playing-time-enable-display () - "Display playing time on mode line." - (interactive) - (setq emms-playing-time-display-p t)) - -;;;###autoload -(defun emms-playing-time-disable-display () - "Remove playing time from mode line." - (interactive) - (setq emms-playing-time-display-p nil)) - -(defun emms-playing-time-display () - "Display playing time on the mode line." - (setq emms-playing-time (1+ emms-playing-time)) - (setq emms-playing-time-string "") - (when emms-playing-time-display-p - (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))) - (case emms-playing-time-style - ((bar) ; `bar' style - (if (zerop total-playing-time) - (setq emms-playing-time-string "[==>........]") - (let ((progress "[") - ;; percent based on 10 - (percent (/ (* emms-playing-time 10) total-playing-time))) - (dotimes (i percent) - (setq progress (concat progress "="))) - (setq progress (concat progress ">")) - (dotimes (i (- 10 percent)) - (setq progress (concat progress " "))) - (setq progress (concat progress "]")) - (setq emms-playing-time-string progress)))) - (t ; `time' style - (setq emms-playing-time-string - (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)))))) - (setq emms-playing-time-string - (format emms-playing-time-display-format - emms-playing-time-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/emms-playlist-limit.el b/emms-playlist-limit.el deleted file mode 100644 index b79d45c..0000000 --- a/emms-playlist-limit.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; emms-playlist-limit.el --- Limit playlist by various info - -;; Copyright (C) 2007 William Xu - -;; Author: William Xu -;; 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. - -;;; Code: - -(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 operations." - :type 'symbol - :group 'emms-playing-limit) - -(defvar emms-playlist-limit-enabled-p nil - "If non-nil, emms playlist limit is enabled.") - -(defun emms-playlist-limit (arg) - "Turn on emms playlist limit if ARG is positive, off otherwise." - (interactive "p") - (if (and arg (> arg 0)) - (progn - (setq emms-playlist-limit-enabled-p t) - (add-hook 'emms-playlist-source-inserted-hook - 'emms-playlist-limit-insert)) - (setq emms-playlist-limit-enabled-p nil) - (remove-hook 'emms-playlist-source-inserted-hook - 'emms-playlist-limit-insert))) - -;;;###autoload -(defun emms-playlist-limit-enable () - "Turn on emms playlist limit." - (interactive) - (emms-playlist-limit 1) - (message "emms playlist limit enabled")) - -;;;###autoload -(defun emms-playlist-limit-disable () - "Turn off emms playlist limit." - (interactive) - (emms-playlist-limit -1) - (message "emms playlist limit disabled")) - -;;;###autoload -(defun emms-playlist-limit-toggle () - "Toggle emms playlist limit." - (interactive) - (if emms-playlist-limit-enabled-p - (emms-playlist-limit-disable) - (emms-playlist-limit-enable))) - -(defmacro define-emms-playlist-limit (attribute) - "Macro for defining emms playlist limit functions." - `(defun ,(intern (format "emms-playlist-limit-to-%s" attribute)) (regexp) - ,(format "Limit to playlists that have %s that matches REGEXP." attribute) - (interactive - (list - (let* ((curr - (or (emms-track-get - (emms-playlist-track-at) (quote ,attribute)) - (emms-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 (emms-track-get (emms-playlist-track-at) (quote ,attribute)))) - (emms-playlist-limit-do (quote ,attribute) 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) - -(defun emms-playlist-limit-to-all () - "Show all tracks again." - (interactive) - (emms-playlist-limit-do nil nil)) - -(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 "/ /") 'emms-playlist-limit-to-all) - - -;;; Low Level Functions - -(defvar emms-playlist-limit-tracks nil - "All tracks in playlist buffer(unlimited).") - -(defun emms-playlist-limit-insert () - "Run in `emms-playlist-source-inserted-hook'." - (with-current-emms-playlist - (emms-playlist-ensure-playlist-buffer) - (setq emms-playlist-limit-tracks - (emms-with-widened-buffer - (emms-playlist-tracks-in-region (point-min) (point-max)))))) - -;; FIXME: When user deletes some tracks, `emms-playlist-limit-tracks' -;; should be updated. -;; (defun emms-playlist-limit-clear () -;; "Run in `emms-playlist-cleared-hook'." -;; (setq emms-playlist-limit-tracks -;; (append emms-playlist-limit-tracks -;; (emms-playlist-tracks-in-region -;; (point-min) (point-max))))) - -(defun emms-playlist-limit-do (name value) - "Limit by NAME with VALUE. -e.g., - (emms-playlist-limit-do 'info-artist \"Jane Zhang\") - -When NAME is nil, show all tracks again. - -See `emms-info-mp3find-arguments' for possible options for NAME." - (with-current-emms-playlist - (emms-playlist-ensure-playlist-buffer) - (let ((curr (emms-playlist-current-selected-track)) - (tracks (emms-playlist-tracks-in-region (point-min) (point-max)))) - (erase-buffer) - (run-hooks 'emms-playlist-cleared-hook) - (if name - (mapc (lambda (track) - (let ((track-value (emms-track-get track name))) - (when (and track-value (string-match value track-value)) - (emms-playlist-insert-track track)))) - tracks) - (mapc (lambda (track) - (emms-playlist-insert-track track)) - emms-playlist-limit-tracks)) - (let ((pos (text-property-any (point-min) (point-max) - 'emms-track curr))) - (if pos - (emms-playlist-select pos) - (emms-playlist-first))) - (run-hooks 'emms-playlist-limit-hook) - (emms-playlist-mode-center-current)))) - - -(provide 'emms-playlist-limit) - -;;; emms-playlist-limit.el ends here diff --git a/emms-playlist-mode.el b/emms-playlist-mode.el deleted file mode 100644 index f451712..0000000 --- a/emms-playlist-mode.el +++ /dev/null @@ -1,614 +0,0 @@ -;;; emms-playlist-mode.el --- Playlist mode for Emms. - -;; Copyright (C) 2005, 2006, 2007, 2008 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.") - -(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 - :group 'emms-playlist-mode) - -(defcustom emms-playlist-mode-window-width 25 - "*Determine the width of the Emms popup window. -The value should a positive integer." - :type 'integer - :group 'emms-playlist-mode) - -(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 - :group 'emms-playlist-mode) - -;;; -------------------------------------------------------- -;;; 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." - :group 'emms-playlist-mode) - -(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." - :group 'emms-playlist-mode) - -;;; -------------------------------------------------------- -;;; Keys -;;; -------------------------------------------------------- - -(defconst 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-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-entire-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-mode-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-clear () - "If the current buffer is an EMMS playlist buffer, clear it. -Otherwise, clear the current EMMS playlist buffer." - (interactive) - (if (and emms-playlist-buffer-p - (not (eq (current-buffer) emms-playlist-buffer))) - (let ((inhibit-read-only t)) - (widen) - (delete-region (point-min) (point-max))) - (emms-playlist-clear))) - -(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-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 () - "Visit the track at point in a `dired' buffer." - (interactive) - (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 (file-name-directory 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 -;; -;; Currently this kills as regular GNU/Emacs would and not like a -;; typical music player would. -(defun emms-playlist-mode-kill-track () - "Kill track at point." - (interactive) - (emms-with-inhibit-read-only-t - (let ((track (emms-playlist-track-at))) - (if track - (let ((track-region (emms-property-region (point) - 'emms-track))) - (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)) - (kill-line)) - (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)))) - -;; C-y -(defun emms-playlist-mode-yank () - "Yank into the playlist buffer." - (interactive) - (emms-with-inhibit-read-only-t - (goto-char (point-at-bol)) - (yank))) - -;; M-y -(defun emms-playlist-mode-yank-pop () - "Cycle through the kill-ring." - (interactive) - (emms-with-inhibit-read-only-t - (yank-pop nil))) - -;;; -------------------------------------------------------- -;;; 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 (find-file-noselect filename)) - (name (buffer-name buffer))) - (with-current-buffer buffer - (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)) - (type (emms-track-get track 'type))) - (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 (eq major-mode 'emms-playlist-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-file)) - (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 () - "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-Playlist") - - (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/emms-playlist-sort.el b/emms-playlist-sort.el deleted file mode 100644 index 3916c74..0000000 --- a/emms-playlist-sort.el +++ /dev/null @@ -1,204 +0,0 @@ -;;; emms-playlist-sort.el --- sort emms playlist - -;; Copyright (C) 2005, 2006, 2007, 2008 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: - -(eval-when-compile (require 'cl)) -(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." - :type 'symbol - :group 'emms-playlist-sort) - -(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 - :group 'emms-playlist-sort) - - -;;; 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) - (if current-prefix-arg - (emms-string> (emms-track-get a (quote ,attribute)) - (emms-track-get b (quote ,attribute))) - (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) - (let ((ret (time-less-p - (or (emms-track-get a 'last-played) '(0 0 0)) - (or (emms-track-get b 'last-played) '(0 0 0))))) - (if current-prefix-arg - (not ret) - ret))))) - -(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) - (let ((ret (< (or (emms-track-get a 'play-count) 0) - (or (emms-track-get b 'play-count) 0)))) - (if current-prefix-arg - (not ret) - ret))))) - -(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 "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) - 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." - (with-current-emms-playlist - (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 (text-property-any - (point-min) (point-max) 'emms-track current))) - (if pos - (emms-playlist-select pos) - (emms-playlist-first)) - ;; (emms-playlist-mode-center-current) - (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))) - (or (emms-string< album-a album-b) - (and album-a - album-b - (string= album-a album-b) - (< (string-to-number (or (emms-track-get a 'info-tracknumber) - "0")) - (string-to-number (or (emms-track-get b 'info-tracknumber) - "0"))))))) - -(defun emms-playlist-sort-by-list-p (a b) - (catch 'return - (dolist (info emms-playlist-sort-list) - (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) - (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/emms-score.el b/emms-score.el deleted file mode 100644 index 02e0d7e..0000000 --- a/emms-score.el +++ /dev/null @@ -1,284 +0,0 @@ -;;; emms-score.el --- Scoring system for mp3player - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) - (setq emms-player-next-function 'emms-score-next-noerror) - (emms-score-load-hash) - (add-hook 'kill-emacs-hook 'emms-score-save-hash)) - (setq emms-score-enabled-p nil) - (setq emms-player-next-function 'emms-next-noerror) - (emms-score-save-hash) - (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-next-noerror () - "Run `emms-next-noerror' with score check. -See also `emms-next-noerror'." - (interactive) - (when emms-player-playing-p - (error "A track is already being played")) - (cond (emms-repeat-track - (emms-start)) - ((condition-case nil - (progn - (emms-playlist-current-select-next) - t) - (error nil)) - (if (emms-score-check-score - (emms-score-current-selected-track-filename)) - (emms-start) - (emms-score-next-noerror))) - (t - (message "No next track in playlist")))) - -(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) - (mapc (lambda (elt) - (puthash (car elt) (cdr elt) emms-score-hash)) - (read - (with-temp-buffer - (insert-file-contents emms-score-file) - (buffer-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/emms-setup.el b/emms-setup.el deleted file mode 100644 index 877a768..0000000 --- a/emms-setup.el +++ /dev/null @@ -1,151 +0,0 @@ -;;; emms-setup.el --- Setup script for EMMS - -;; Copyright (C) 2005, 2006, 2007 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) - "*Default list of players for emms-setup." - :group 'emms-setup - :type 'list) - -;;;###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)) - -;;;###autoload -(defun emms-standard () - "An Emms setup script. -Everything included in the `emms-minimalistic' setup, the Emms -interactive playlist mode, reading information from tagged -audio files, and a metadata cache." - ;; include - (emms-minimalistic) - ;; define - (eval-and-compile - (require 'emms-playlist-mode) - (require 'emms-info) - (require 'emms-info-mp3info) - (require 'emms-info-ogginfo) - (require 'emms-cache)) - ;; setup - (setq emms-playlist-default-major-mode 'emms-playlist-mode) - (add-to-list 'emms-track-initialize-functions 'emms-info-initialize-track) - (when (executable-find emms-info-mp3info-program-name) - (add-to-list 'emms-info-functions 'emms-info-mp3info)) - (when (executable-find emms-info-ogginfo-program-name) - (add-to-list 'emms-info-functions 'emms-info-ogginfo)) - (setq emms-track-description-function 'emms-info-track-description) - (when (fboundp 'emms-cache) ; work around compiler warning - (emms-cache 1))) - -;;;###autoload -(defun emms-all () - "An Emms setup script. -Everything included in the `emms-standard' setup and adds all the -stable features which come with the Emms distribution." - ;; include - (emms-standard) - ;; define - (eval-and-compile - (require 'emms-mode-line) - (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-lastfm)) - ;; setup - (emms-mode-line 1) - (emms-mode-line-blank) - (emms-lyrics 1) - (emms-playing-time 1)) - -;;;###autoload -(defun emms-devel () - "An Emms setup script. -Everything included in the `emms-all' setup and adds all the -features which come with the Emms distribution regardless of if -they are considered stable or not. Use this if you like living -on the edge." - ;; include - (emms-all) - ;; define - (eval-and-compile - (require 'emms-metaplaylist-mode) - (require 'emms-stream-info) - (require 'emms-score) - (require 'emms-last-played) - (require 'emms-bookmarks) - (require 'emms-history) - (require 'emms-mark) - (require 'emms-i18n) - (require 'emms-tag-editor) - (require 'emms-volume) - (require 'emms-playlist-limit)) - ;; setup - (add-hook 'emms-player-started-hook 'emms-last-played-update-current) - (emms-score 1) - (emms-playlist-limit 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)) - -(provide 'emms-setup) -;;; emms-setup.el ends here diff --git a/emms-source-file.el b/emms-source-file.el deleted file mode 100644 index 16a9461..0000000 --- a/emms-source-file.el +++ /dev/null @@ -1,298 +0,0 @@ -;;; emms-source-file.el --- EMMS sources from the filesystem. - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) -(eval-when-compile - (condition-case nil - (require 'locate) - (error nil))) -(require 'dired) - -(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 'string - :group 'emms-source-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) - :group 'emms-source-file) - -(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 - :group 'emms-source-file) - -(defcustom emms-source-file-gnu-find "find" - "*The program name for GNU find." - :type 'string - :group 'emms-source-file) - -;; 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)) - -;;; 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-default-directory - 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-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 '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-default-directory - 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 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 (string-match "/\\.\\.?$" (car dirs)) - (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 - (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 "sPlay URL: ") - (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))) - -;;;###autoload (autoload 'emms-play-lastfm "emms-lastfm" nil t) -;;;###autoload (autoload 'emms-add-lastfm "emms-lastfm" nil t) -(define-emms-source lastfm (lastfm-url) - "An EMMS source for Last.fm URLs, which begin with lastfm://." - (interactive "sPlay Last.fm URL: ") - (emms-playlist-insert-track (emms-track 'lastfm lastfm-url))) - - -(provide 'emms-source-file) -;;; emms-source-file.el ends here diff --git a/emms-source-playlist.el b/emms-source-playlist.el deleted file mode 100644 index 08f62a3..0000000 --- a/emms-source-playlist.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; emms-source-playlist.el --- EMMS sources from playlist files - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) - -;;; 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) - (funcall (emms-source-playlist-parse-sym format))) - -(defun emms-source-playlist-unparse (format playlist file) - (funcall (emms-source-playlist-unparse-sym format) playlist file)) - -(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 - (intern - (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"))))) - -(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))) - (with-temp-buffer - (emms-source-playlist-unparse format - (with-current-emms-playlist - (current-buffer)) - (current-buffer)) - (let ((backup-inhibited t)) - (write-file file)))) - -(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 - (insert-file-contents file) - (goto-char (point-min)) - (let ((format (emms-source-playlist-determine-format))) - (if format - (emms-source-playlist-parse format) - (error "Not a recognized playlist format")))))) - -;;; EMMS native playlists - -;; Format: -;; ;;; This is an EMMS playlist file. Play it with M-x emms-play-playlist -;; - -(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 "^;;; This is an EMMS playlist file"))) - -(defun emms-source-playlist-parse-native () - "Parse the native EMMS playlist in the current buffer." - (save-excursion - (goto-char (point-min)) - (read (current-buffer)))) - -(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 ";;; This is an EMMS playlist file." - " Play it with M-x emms-play-playlist\n") - (insert "(") - (let ((track (emms-source-playlist-first in)) - (firstp t)) - (while track - (if (not firstp) - (insert "\n ") - (setq firstp nil)) - (prin1 track (current-buffer)) - (setq track (emms-source-playlist-next in)))) - (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 - (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)))) - -;;; 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 () - "Parse the m3u playlist in the current buffer." - (mapcar (lambda (file) - (if (string-match "\\`http://\\|\\`mms://" file) - (emms-track 'url file) - (emms-track 'file file))) - (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 - (with-current-buffer out - (let ((track (emms-source-playlist-first in))) - (while track - (insert (emms-track-name track) ?\n) - (setq track (emms-source-playlist-next in)))))))) - -;;;###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 - (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)))) - -;;; 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 () - "Parse the pls playlist in the current buffer." - (mapcar (lambda (file) - (if (string-match "\\`http://\\|\\`mms://" file) - (emms-track 'url file) - (emms-track 'file file))) - (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 - (with-current-buffer out - (let ((pos 0)) - (insert "[playlist]\n") - (save-restriction - (narrow-to-region (point) (point)) - (let ((track (emms-source-playlist-first in))) - (while track - (setq pos (1+ pos)) - (insert "File" (number-to-string pos) "=" - (emms-track-name track) ?\n) - (setq track (emms-source-playlist-next in)))) - (goto-char (point-min)) - (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 - (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)))) - -;;; 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 - -;;; Helper functions - -(defun emms-source-playlist-first (buf) - "Return the first track in BUF. -This moves point." - (with-current-buffer buf - (condition-case nil - (progn - (emms-playlist-first) - (emms-playlist-track-at (point))) - (error - nil)))) - -(defun emms-source-playlist-next (buf) - "Return the next track in BUF. -This moves point." - (with-current-buffer buf - (condition-case nil - (progn - (emms-playlist-next) - (emms-playlist-track-at (point))) - (error - nil)))) - -;;; 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/emms-stream-info.el b/emms-stream-info.el deleted file mode 100644 index 324a247..0000000 --- a/emms-stream-info.el +++ /dev/null @@ -1,744 +0,0 @@ -;;; emms-stream-info.el --- Info from streaming audio - -;; Copyright (C) 2004, 2005, 2006, 2007 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-stream-info' establishes a TCP connection with the server and -;; sends an HTTP request string. The server (hopefully) responds with -;; some header information describing the streaming audio channel, -;; some audio data and then the name of the song being played (usually -;; in that order). -;; -;; Some stations like WCPE [http://wcpe.org], while giving excellent -;; broadcasts do not support title streaming over MP3 or Ogg. Using -;; this software on such stations will only result in general station -;; information and not the artist name or title of the track being -;; played. - -;;; Functionality: -;; -;; Currently supports Icecast and Shoutcast servers with Ogg and MP3 -;; streams. - -;;; Use: -;; -;; Look at the documentation strings for the three interactive -;; functions: 'emms-stream-info-get', 'emms-stream-info-message' and -;; 'emms-stream-info-insert'. - -;;; Important Notes: -;; -;; 1) This software does not parse, cache or save audio data at -;; all. This software downloads a limited amount of data from a -;; given streaming audio channel per call. This software is -;; optimized to download as little as possible from a given -;; streaming audio channel and then to immediately disconnect. -;; -;; 2) This software disregards and then discards all audio data -;; automatically after each call. -;; -;; 3) This software connects for a maximum of 10 seconds and then -;; immediately disconnects. Usually the software will disconnect -;; long before the 10 second limit is reached. -;; -;; 4) It is the responsibility of the user to read the Terms of -;; Service of the streaming audio channel before running this -;; software on that channel's service. Some streaming audio -;; channels explicitly request 3rd party applications not to -;; connect to their service. This is their prerogative. Respect it. - -;; $Id: emms-stream-info.el,v 1.8 2005/07/09 11:56:00 forcer Exp $ - -;;; Code: - -(require 'emms) - -;; A higher value for 'emms-stream-info-max' this gives us a -;; correspondingly higher chance of grabbing the title information -;; from a stream but incurs a price in the additional time it takes to -;; download. -;; -;; This value is not relevant for Ogg streams since the title info in -;; Ogg streams arrives almost immediately. -;; -;; Do not set under 30000 since the typical value of 'metaint' on most -;; streaming audio servers is either 8192 or 24576 -(defconst emms-stream-info-max 120000 - "Byte limit for downloads.") - -(defconst emms-stream-info-timeout 10 - "Seconds to timeout connection (dead or alive).") - -(defconst emms-stream-info-verbose t - "Output real-time information about the connection.") - -(defconst emms-stream-info-version - "$Revision: 1.8 $" - "Software version.") - -(defconst emms-stream-info-char-alter-regexp "[-,'=:%+&0-9A-Za-z\.()/ ]" - "Unified character alternative clause for regular expressions.") - -(defconst emms-stream-info-shoutcast-regexp - (concat emms-stream-info-char-alter-regexp ".*?") - "Regular expression for Shoutcast.") - -(defconst emms-stream-info-icecast-regexp - (concat emms-stream-info-char-alter-regexp "+") - "Regular expression for Icecast.") - -(defconst emms-stream-info-shoutcast-title-regexp - (concat "StreamTitle='\\(" emms-stream-info-shoutcast-regexp "\\)';") - "Regular expression for Shoutcast.") - -;; Reference: http://www.xiph.org/ogg/vorbis/doc/framing.html -(defconst emms-stream-info-icecast-capture-pattern "Oggs\\(.*\\)BCV" - "Regular Expression for the beggining of an Ogg bitstream page.") - -;; For all servers -(defconst emms-stream-info-stream-header-regexp - (concat emms-stream-info-char-alter-regexp "+") - "Regular expression for metainformation headers.") - -(defconst emms-stream-info-streamlist-regexp - "\\(^http://.*\\)\\|^File.=\\(http://.*\\)" - "Regular expression for streamlist URLs.") - -;; When t output debugging info -(defconst emms-stream-info-debugging nil - "If t then emms-stream-info will spill the stream into a buffer. -Set to NIL unless you want a buffer filled with binary junk.") - -(defconst emms-stream-info-debug-buffer "*emms-stream-info-debug*" - "Buffer for debugging information.") - -(defconst emms-stream-info-vocab (list "name" - "genre" - "pub" - "metaint" - "br" - "bitrate" - "description" - "public" - "audio-info") - "List of header keys.") - -(defconst emms-stream-info-format-string - "Now streaming:%s, %c %bKb/sec" - "The following %-sequences are supported: - -%b Bitrate -%s Song title and artist name -%c Station/Channel name and short description -%t Song title -%g Station/Channel genre -%a Artist name - -Note that some stations do not supply artist and song title -information.") - -(defconst emms-stream-info-format-string-notitle - "Now streaming: %c %bKb/sec %g" - "Some streaming audio stations/channels do not provide artist -and songtitle information. This string specifies an alternate -format for those stations.") - -(defconst emms-stream-info-pls-regexp ".*\.pls" - "Regular expression for a .pls streamlist file.") - -(defconst emms-stream-info-m3u-regexp ".*\.m3u" - "Regular expression for a .m3u streamlist file.") - -(defvar emms-stream-info-url nil - "Server URL.") - -(defvar emms-stream-info-port nil - "Server port.") - -(defvar emms-stream-info-found nil - "Results of our search.") - -(defvar emms-stream-info-streamlist-found nil - "Results of our streamlist search.") - -(defvar emms-stream-info-procname "emms-stream-info-process" - "Name of network connection process.") - -(defvar emms-stream-info-downloaded 0 - "Amount of stream data downloaded.") - -(defvar emms-stream-info-read-inhibit nil - "When t do not attempt to read 'emms-stream-info-found'.") - -(defvar emms-stream-info-return-hook nil - "Activated after the disconnection from the streaming audio server.") - -(defvar emms-stream-info-read-hook nil - "Activated after the disconnection from the streaming audio -server. This hook is for integration purposes, for general user -functions use 'emms-stream-info-return-hook'.") - -(defvar emms-stream-info-header-flag nil - "Non-nil means header information has been captured.") - -(defvar emms-stream-info-title-flag nil - "Non-nil means title information has been captured.") - -(defvar emms-stream-info-streamlist-flag nil - "Non-nil means streamlist information has been captured.") - -(defvar emms-stream-info-request-string nil - "String sent to streaming audio server.") - -(defun emms-stream-info-decompose-url (urlstr) - "Return a vector containing the elements of the URI URLSTR." - (let ((host nil) - (file nil) - (port nil) - (protocol nil) - (user nil) ; nil - (pass nil) ; nil - (refs nil) ; nil - (attr nil) ; nil - (full nil) - (pos 1)) - (with-temp-buffer - (insert urlstr) - (goto-char (point-min)) - (if (looking-at "http") - (progn - (forward-char 4) - (setq protocol (buffer-substring-no-properties pos (point))) - (setq pos (point)))) - (skip-chars-forward "://") - (setq pos (point)) - (skip-chars-forward "^/") - (setq host (buffer-substring pos (point))) - (if (string-match ":\\([0-9+]+\\)" host) - (setq port (string-to-number (match-string 1 host)) - host (substring host 0 (match-beginning 0)))) - (setq pos (point)) - (setq file (buffer-substring pos (point-max))) - (setq full (buffer-substring (point-min) (point-max)))) - ;; Return in format compatible with 'url-generic-parse-url'. - (vector protocol user pass host port file refs attr full))) - -;; This is our tiny state machine for keeping track across multiple -;; connections. -(defvar emms-stream-info-state-bv - (if (fboundp 'make-bool-vector) - (make-bool-vector 3 nil) - (make-vector 3 nil)) - "State of sequential connections. -true at index 0 means output formatted message. -true at index 1 means insert formatted message. -trye at index 2 means continue to next connection.") - -;; This bit is ugly and non-lispish, but asynchronous communications -;; need a state machine. Better to do it with a macro. and once -;; everything works I will too! -(defun emms-stream-info-set-message () - (aset emms-stream-info-state-bv 0 t)) -(defun emms-stream-info-unset-message () - (aset emms-stream-info-state-bv 0 nil)) -(defun emms-stream-info-message-p () - (aref emms-stream-info-state-bv 0)) - -(defun emms-stream-info-set-insert () - (aset emms-stream-info-state-bv 1 t)) -(defun emms-stream-info-unset-insert () - (aset emms-stream-info-state-bv 1 nil)) -(defun emms-stream-info-insert-p () - (aref emms-stream-info-state-bv 1)) - -(defun emms-stream-info-set-continue () - (aset emms-stream-info-state-bv 2 t)) -(defun emms-stream-info-unset-continue () - (aset emms-stream-info-state-bv 2 nil)) -(defun emms-stream-info-continue-p () - (aref emms-stream-info-state-bv 2)) - -(defun emms-stream-info-streamlist-type (str) - (if (stringp str) - (cond ((string-match emms-stream-info-pls-regexp str) - 'pls) - ((string-match emms-stream-info-m3u-regexp str) - 'm3u) - (t nil)) - nil)) - -(defun emms-stream-info-format (str format-alist) - (let ((key-list (mapcar 'car format-alist))) - (setq key-list (mapcar 'car format-alist)) - (mapc (lambda (e) - (setq str - (emms-replace-regexp-in-string - e - (cdr (assoc e format-alist)) - str))) - key-list)) - str) - -;; Output a human readable message -(defun emms-stream-info-pretty-print (&optional string-out) - "Output a human readable message. If STRING-OUT is non-nil, do -not output a message and only return a string." - (let (str - (format-string emms-stream-info-format-string) - (format-alist - (list - (cons "%b" (or (emms-stream-info-get-key "br") - (emms-stream-info-get-key "bitrate") - "")) - (cons "%s" (or (emms-stream-info-get-key "songtitle") "")) - (cons "%c" (or (emms-stream-info-get-key "name") "")) - (cons "%t" (or (emms-stream-info-get-key "title") "")) - (cons "%g" (or (emms-stream-info-get-key "genre") "")) - (cons "%a" (or (emms-stream-info-get-key "artist") "")) - (cons "%. " "")))) ; clean untreated tags - - ;; Choose alternate string format if necessary - (unless (emms-stream-info-get-key "title") - (setq format-string emms-stream-info-format-string-notitle)) - - ;; format according to the format-string - (setq str - (emms-stream-info-format - format-string - format-alist)) - - ;; Escape rougue percent signs hiding in our string. - (setq str (emms-replace-regexp-in-string "%" "%%" str)) - - ;; Either output a message or return a string. But only if it is - ;; an identifiable station/channel - (when (emms-stream-info-get-key "name") - (if string-out - str - (message "%s" str))))) - -(defun emms-stream-info-pretty-print-insert () - "Insert the formatted output of 'emms-stream-info-get' at point." - (insert (or (emms-stream-info-pretty-print t) ""))) - -(defun emms-stream-info-continue () - (emms-stream-info-unset-continue) - (if emms-stream-info-streamlist-found - (emms-stream-info-get emms-stream-info-streamlist-found - (emms-stream-info-message-p) - (emms-stream-info-insert-p) - nil) - (error "No streamlist found at URL"))) - -;; Useful -(defun list-to-string (l) - "Return a STRING which is the concatenation of the elements of -L." - (if (not l) - nil - (if (stringp (car l)) - (concat (car l) (list-to-string (cdr l))) - (list-to-string (cdr l))))) - -(defun emms-stream-info-get-key (key) - "Return STRING associated with KEY." - (unless emms-stream-info-read-inhibit - (cdr (assoc key emms-stream-info-found)))) - -(defun emms-stream-info-get-keys (keys) - "Return a list of strings associated with each key in -KEYS. KEYS should be a list of strings." - (mapcar (lambda (e) - (emms-stream-info-get-key e)) - keys)) - -;; BEGIN to END should typically be a segment of about 250 Bytes -;; length for Ogg streams. -(defun emms-stream-info-decode-ogg (begin end) - "Parse Ogg stream segment from BEGIN to END." - (let ((artist nil) - (title nil)) - - (goto-char begin) - (re-search-forward (concat "artist=\\(" - emms-stream-info-icecast-regexp - "\\)") end t) - (setq artist (emms-match-string-no-properties 1)) - - (goto-char begin) - (re-search-forward (concat "title=\\(" - emms-stream-info-icecast-regexp - "\\)") end t) - (setq title (emms-match-string-no-properties 1)) - - ;; ugh - (if (or artist title) - (list (cons "songtitle" (concat artist - (if (and artist title) - " - " - " ") - title)) - (cons "artist" artist) - (cons "title" title)) - nil))) - -;; BEGIN to END should be about 20 Bytes long -(defun emms-stream-info-decode-mp3 (begin end) - "Parse Shoutcast/Icecast-MP3 segment from BEGIN to END." - (let ((split nil) - (songtitle nil) - (artist nil) - (title nil)) - - (goto-char begin) - (setq songtitle (buffer-substring begin end) - split (split-string songtitle "-")) - - (if (cdr split) - (setq artist (car split) - title (list-to-string (cdr split)))) - - (list (cons "songtitle" songtitle) - (cons "artist" artist) - (cons "title" title)))) - -(defun emms-stream-info-filter (proc str) - "Filter function for the network process. -Argument PROC Process. -Argument STR Quanta of data." - - ;; Debugging flag dependent - (if emms-stream-info-debugging - (with-current-buffer emms-stream-info-debug-buffer - (insert str))) - - (with-temp-buffer - (setq emms-stream-info-downloaded (+ emms-stream-info-downloaded - (length str))) - - ;; Insert a quanta of data. - (insert str) - - ;; Look for headers - (unless emms-stream-info-header-flag - (mapc (lambda (term) - (goto-char (point-min)) - (if (re-search-forward - (concat (regexp-opt - (list "icy-" "ice-")) - term - ":\\(" - emms-stream-info-stream-header-regexp - "\\)") - (point-max) t) - (progn - (add-to-list 'emms-stream-info-found - (cons term - (emms-match-string-no-properties 1))) - (setq emms-stream-info-header-flag t)))) - emms-stream-info-vocab)) - - ;; Look for title - (unless emms-stream-info-title-flag - (goto-char (- (point) - (length str))) - (cond ((re-search-forward - emms-stream-info-icecast-capture-pattern - (point-max) - t) - (setq emms-stream-info-found - (append - emms-stream-info-found - (emms-stream-info-decode-ogg - (match-beginning 1) - (match-end 1)))) - (setq emms-stream-info-title-flag t)) - ;; In retrospect this section mimics input_http.c from - ;; the Xine project only that it uses buffer searching. - ((re-search-forward - emms-stream-info-shoutcast-title-regexp - (point-max) - t) - (setq emms-stream-info-found - (append emms-stream-info-found - (emms-stream-info-decode-mp3 - (match-beginning 1) - (match-end 1)))) - (setq emms-stream-info-title-flag t)))) - - ;; Too many nested conditions - (if (emms-stream-info-set-continue) - (unless emms-stream-info-streamlist-flag - (goto-char (point-min)) - (if (re-search-forward - emms-stream-info-streamlist-regexp - (point-max) t) - (progn - (setq emms-stream-info-streamlist-found - (or (emms-match-string-no-properties 1) - (emms-match-string-no-properties 2))) - (setq emms-stream-info-streamlist-flag t)))))) - - ;; Be chatty at the user - (if emms-stream-info-verbose - (message "Connection %s. Downloaded %d/%d bytes." - (process-status proc) - emms-stream-info-downloaded - emms-stream-info-max)) - - ;; Find out if we need to kill the connection - (if (or (> emms-stream-info-downloaded emms-stream-info-max) ; maxed out? - ;; Captured header and title info? - (and emms-stream-info-header-flag emms-stream-info-title-flag) - ;; Captured streamlist info? - emms-stream-info-streamlist-flag) - (emms-stream-info-kill-process proc))) - -;; Closing the connection proves to be the most difficult part of the -;; program. There is a difference in the way emacs21 vs. emacs22 -;; behave. -(defun emms-stream-info-kill-process (proc) - "Hold Emacs while trying to close the connection. -Argument PROC Process." - (while (not (equal (process-status proc) 'closed)) - (delete-process proc)) - (if (process-filter proc) - (set-process-filter proc nil)) - ;; Workaround Emacs 21 sentinel problems - (when (= emacs-major-version 21) - (emms-stream-info-after-function))) - -(defun emms-stream-info-after-function () - "Evalutated when the connection ends." - (setq emms-stream-info-read-inhibit nil) ; allow reading - (run-hooks 'emms-stream-info-read-hook) - (run-hooks 'emms-stream-info-return-hook)) - -(defun emms-stream-info-sentinel (proc ev) - "Sentinel function for network process. -Argument PROC Process. -Argument EV Event string." - ;; Workaround Emacs 21 sentinel problems - (unless (= emacs-major-version 21) - (emms-stream-info-after-function))) - -(defun emms-stream-info-make-request-string (file) - "Return a valid HTTP request string with FILE as a URI." - (concat "GET " - (if (equal file "") - "/" - file) - " HTTP/1.0\r\n" - "User-Agent: Free software (see www.gnu.org), reads title of currently playing track (discards audio).\r\n" - "Icy-MetaData:1\r\n" - "\r\n")) - -(defun emms-stream-info-parse-url (urlstring) - "Set the global variables for connecting to the streaming audio -server at URLSTRING." - (let* ((url (emms-stream-info-decompose-url urlstring)) - (hostname (elt url 3)) - (port (elt url 4)) - (file (elt url 5)) - (protocol (elt url 0))) - - (cond ((or (not (equal protocol "http")) - (equal hostname "")) - (error "Invalid URL")) - - ;; eg. "http://music.station.com:8014" - ((and (empty-string-p file) - port) - (setq emms-stream-info-port port)) - - ;; eg. "http://ogg.smgradio.com/vr96.ogg" - ((and (not (empty-string-p file)) - (or (equal port "") - (equal port nil) - (equal port 0))) - (setq emms-stream-info-port 80)) - - ;; eg. "http://audio.ibiblio.org:8010/wcpe.ogg" - ((and (not (empty-string-p file)) - port) - (setq emms-stream-info-port port)) - - (t (error "Invalid URL"))) - - (setq emms-stream-info-url hostname - emms-stream-info-request-string - (emms-stream-info-make-request-string file)))) - -(defun empty-string-p (str) - "Return t if STR is equal to the empty string." - (equal str "")) - -(defun emms-stream-info-reset-state () - (setq emms-stream-info-downloaded 0) ; restart fallback - (setq emms-stream-info-title-flag nil) ; forget title flag - (setq emms-stream-info-header-flag nil) ; forget header flag - (setq emms-stream-info-found nil) ; forget output - (setq emms-stream-info-streamlist-found nil) ; forget streamlist - (setq emms-stream-info-streamlist-flag nil) ; forget streamlist - (setq emms-stream-info-read-inhibit t) ; do not read output - - ;; Reset state machine - (emms-stream-info-unset-message) - (emms-stream-info-unset-insert) - (emms-stream-info-unset-continue) - - ;; forget hooks - (remove-hook 'emms-stream-info-return-hook - 'emms-stream-info-pretty-print) - (remove-hook 'emms-stream-info-return-hook - 'emms-stream-info-continue) - (remove-hook 'emms-stream-info-return-hook - 'emms-stream-info-pretty-print-insert)) - -;; ------------------------------------------------------------------- -;; Interactive functions -;; ------------------------------------------------------------------- - -(defun emms-stream-info-get (&optional urlstring say write cont) - "Get streaming audio server header metadata and song title from stream at URL. -Argument URLSTRING Address of streaming audio server as a string. -If URLSTRING is nil then get the latest stream played via emms. -Optional argument SAY boolean. -Optional argument WRITE boolean. -Optional argument CONT boolean." - (interactive) - - (if urlstring - (emms-stream-info-parse-url urlstring) - (and (boundp 'emms-stream-last-stream) - (fboundp 'emms-stream-url) - emms-stream-last-stream - (emms-stream-info-parse-url - (emms-stream-url emms-stream-last-stream)))) - - (emms-stream-info-reset-state) - - ;; Output formatted text as a message. - (if say - (progn - (add-hook 'emms-stream-info-return-hook - 'emms-stream-info-pretty-print) - (emms-stream-info-set-message))) - ;; Insert formatted text into the current buffer. - (if write - (progn - (add-hook 'emms-stream-info-return-hook - 'emms-stream-info-pretty-print-insert) - (emms-stream-info-set-insert))) - ;; Continue to the next connection after this one. - (if cont - (progn - (add-hook 'emms-stream-info-return-hook - 'emms-stream-info-continue) - (emms-stream-info-set-continue))) - - ;; Debugging flag dependent - (if emms-stream-info-debugging - (progn - (if (get-buffer emms-stream-info-debug-buffer) - (kill-buffer emms-stream-info-debug-buffer)) - (get-buffer-create emms-stream-info-debug-buffer))) - - ;; Open connection - (condition-case nil - (if (fboundp 'make-network-process) - (make-network-process :name emms-stream-info-procname - :buffer nil - :host emms-stream-info-url - :service emms-stream-info-port) - (open-network-stream emms-stream-info-procname - nil - emms-stream-info-url - emms-stream-info-port)) - (error - (emms-stream-info-reset-state) - (message "Error connecting to streaming audio sever at %s" - emms-stream-info-url))) - - (let ((proc (get-process emms-stream-info-procname))) - (when proc - - ;; Connection timeone - (run-at-time emms-stream-info-timeout - nil - 'emms-stream-info-kill-process - proc) - - ;; Start download - (process-send-string emms-stream-info-procname - emms-stream-info-request-string) - (set-process-sentinel proc - 'emms-stream-info-sentinel) - (set-process-filter proc - 'emms-stream-info-filter) - (unless (process-sentinel proc) - (error "No process sentinel"))))) - -;; Should be phased out. -;; (defun emms-stream-info-input-sanity (&optional urlstring) -;; (let ((type (emms-track-type (emms-playlist-selected-track)))) -;; (cond ((null urlstring) -;; (if (or (equal type 'streamlist) -;; (equal type 'url)) -;; (emms-track-name (emms-playlist-selected-track)))) -;; ((not (stringp urlstring)) -;; (error "URL must be in string format")) -;; ((stringp url) urlstring)))) - -(defun emms-stream-info-input-sanity (&optional urlstring) - (if (stringp urlstring) - urlstring - (error "URL must be in string format"))) - -(defun emms-stream-info-message (&optional urlstring) - "Get information from streaming audio server at URLSTRING. -Return a formatted message. -URLSTRING should be a string." - (interactive) - (let ((url (emms-stream-info-input-sanity urlstring))) - (cond ((equal (emms-stream-info-streamlist-type url) 'pls) - (emms-stream-info-get url t nil t)) - ((equal (emms-stream-info-streamlist-type url) 'm3u) - (emms-stream-info-get url t nil t)) - (t (emms-stream-info-get url t))))) - -;; Insertion does not work for sequential connections. -(defun emms-stream-info-insert (&optional urlstring) - "Get information from streaming audio server at URLSTRING. -Insert a formatted message at point. -URLSTRING should be a string." - (interactive) - (let ((url (emms-stream-info-input-sanity urlstring))) - (cond ((equal (emms-stream-info-streamlist-type url) 'pls) - (emms-stream-info-get url nil t t)) - ((equal (emms-stream-info-streamlist-type url) 'm3u) - (emms-stream-info-get url nil t t)) - (t (emms-stream-info-get url nil t))))) - -(provide 'emms-stream-info) - -;;; emms-stream-info.el ends here diff --git a/emms-streams.el b/emms-streams.el deleted file mode 100644 index 711ad6f..0000000 --- a/emms-streams.el +++ /dev/null @@ -1,652 +0,0 @@ -;; emms-streams.el -- interface to add and play streams - -;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. - -;; Authors: Lucas Bonnet -;; Jose A Ortega Ruiz -;; Yoni Rabkin -;; 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 -;; 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: - -;; It is part of the EMMS package - -;; Heavily based on bmk-mgr.el by Jose A Ortega Ruiz -;; thanks to you ! - -;;; Code: - -(require 'emms) -(require 'later-do) - -(defgroup emms-stream nil - "*Add and play streams with EMMS." - :group 'emms) - -(defcustom emms-stream-bookmarks-file (concat (file-name-as-directory emms-directory) "streams") - "*The file where you store your favorite emms streams." - :type 'file - :group 'emms-stream) - -(defcustom emms-stream-default-action "add" - "*The default action when you press RET in the EMMS Stream interface. -Can be either \"add\" or \"play\". The default is \"add\"." - :type 'string - :group 'emms-stream) - -(defface emms-stream-name-face '((t (:bold t :foreground nil :weight bold))) - "Face for stream names." - :group 'emms-stream) - -(defface emms-stream-url-face - '((((class color) (background dark)) - (:foreground "LightSteelBlue")) - (((class color) (background light)) - (:foreground "Blue"))) - "Face for stream URLs." - :group 'emms-stream) - -(defvar emms-stream-list nil - "The list that contains your current stream bookmarks.") - -(defvar emms-stream-buffer-name "*EMMS Streams*" - "The name of the buffer used by emms-stream interface.") - -(defvar emms-stream-play-hook nil - "*A hook run when you add or play an EMMS stream via the popup.") - -(defvar emms-stream-hook nil -"*A hook run when you call emms-streams or emms-stream-popup.") - -(defvar emms-stream-current-stream nil - "The stream currently being played. -Needed by the info method, as the track doesn't contain all the -needed info.") - -(defvar emms-stream-popup-old-conf nil - "Old window configuration.") - -(defvar emms-stream-last-stream nil - "The last stream added/played by EMMS.") - -(defvar emms-stream-playlist-buffer nil - "The EMMS playlist buffer associated with emms-streams.") - -(defcustom emms-stream-repeat-p nil - "*If non-nil, try to repeat a streamlist if it gets disconnected." - :set (function - (lambda (sym val) - (when (buffer-live-p emms-stream-playlist-buffer) - (with-current-buffer emms-stream-playlist-buffer - (setq emms-repeat-playlist val))) - (set sym val))) - :type 'boolean - :group 'emms-stream) - -;; Format: (("descriptive name" url feed-number type)) -;; -;; type could be either url, playlist, or lastfm. If url, then it -;; represents a direct IP, if streamlist it's a stream playlist, if -;; lastfm it's a lastfm station -(defvar emms-stream-default-list - '(("SomaFM: Beatblender" - "http://www.somafm.com/beatblender.pls" 1 streamlist) - ("SomaFM: Secret Agent" - "http://www.somafm.com/secretagent.pls" 1 streamlist) - ("SomaFM: Groove Salad" - "http://www.somafm.com/groovesalad.pls" 1 streamlist) - ("SomaFM: Drone Zone" - "http://www.somafm.com/dronezone.pls" 1 streamlist) - ("SomaFM: Tag's Trance" - "http://www.somafm.com/tagstrance.pls" 1 streamlist) - ("SomaFM: Indie Pop Rocks" - "http://www.somafm.com/indiepop.pls" 1 streamlist) - ("SomaFM: Doomed" - "http://www.somafm.com/doomed.pls" 1 streamlist) - ("Digitally Imported, Trance" - "http://www.di.fm/mp3/trance.pls" 1 streamlist) - ("Digitally Imported, Deephouse" - "http://www.di.fm/mp3/deephouse.pls" 1 streamlist) - ("Digitally Imported, Chillout" - "http://www.di.fm/mp3/chillout.pls" 1 streamlist) - ("Digitally Imported, Drum and Bass" - "http://www.di.fm/mp3/drumandbass.pls" 1 streamlist) - ("SKY.fm, Mostly Classical" - "http://www.sky.fm/mp3/classical.pls" 1 streamlist) - ("SKY.fm, Jazz" - "http://www.sky.fm/mp3/jazz.pls" 1 streamlist) - ("Philosomatika, Goa-Trance" - "http://www.shoutcast.com/sbin/shoutcast-playlist.pls?rn=1712&file=filename.pls" 1 streamlist) - ("Drum and Bass Radio, BassDrive" - "http://www.bassdrive.com/BassDrive.m3u" 1 streamlist) - ("Flaresound, Jazzmusique" - "http://64.236.34.196:80/stream/1016" 1 url) - ("Flaresound, Jazzmusique" - "http://205.188.234.4:8004" 2 url) - ("Flaresound, L'Electric" - "http://www.bp6.com:8002" 1 url) - ("Stangs Garage, Eclectic" - "http://www.stangsgarage.com/listen.pls" 1 streamlist) - ("DNA Lounge, Live" - "http://www.dnalounge.com/webcast/128.m3u" 1 streamlist) - ("DNA Lounge Radio" - "http://www.dnalounge.com/webcast/dnaradio.m3u" 1 streamlist) - ("Virgin Radio, The Groove" - "http://www.smgradio.com/core/audio/ogg/live.pls?service=grbb" - 1 streamlist) - ("Virgin Radio, Virgin Classic" - "http://www.smgradio.com/core/audio/ogg/live.pls?service=vcbb" - 1 streamlist) - ("Virgin Radio, Virgin 1215AM" - "http://www.smgradio.com/core/audio/ogg/live.pls?service=vrbb" - 1 streamlist) - ("Voices From Within - Words From Beyond" - "http://207.200.96.225:8024/listen.pls" 1 streamlist) - ("WCPE, Classical Music" - "http://www.ibiblio.org/wcpe/wcpe.pls" 1 streamlist) - ("PLUG: Voices of the Free Software movement" - "http://purduelug.org:8000/voices-free_software.ogg" 1 url) - ("VGamp Radio, Video Game music" - "http://vgamp.com/listen128.pls" 1 streamlist) - ("Kohina - Old school game and demo music" - "http://stream.nute.net/kohina/stream.ogg.m3u" 1 streamlist) - ("Nectarine, Demoscene Radio" - "http://www.scenemusic.eu:8002/high.ogg.m3u" 1 streamlist) - ("idobi Radio" - "http://www.idobi.com/radio/iradio.pls" 1 streamlist) - ("radio.wazee - Modern Alternative Rock" - "http://www.wazee.org/128.pls" 1 streamlist) - ("ChroniX Aggression - Loud & Clear" - "http://www.chronixradio.com/chronixaggression/listen/listen.pls" - 1 streamlist) - ("WFMU, Freeform radio" - "http://www.wfmu.org/wfmu.pls" 1 streamlist) - ("KEXP - Seattle Community Radio" - "http://kexp-mp3-128k.cac.washington.edu:8000/listen.pls" 1 streamlist) - ("KRUU-LP - Fairfield, Iowa Community Radio" - "http://kruufm.com/live.pls" 1 streamlist) - ("WBCR-LP - Berkshire Community Radio" - "http://nyc01.egihosting.com:6232/listen.pls" 1 streamlist))) - -(defvar emms-stream-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map (kbd "C-a") 'beginning-of-line) - (define-key map (kbd "C-e") 'end-of-line) - (define-key map (kbd "C-k") 'emms-stream-kill-bookmark) - (define-key map (kbd "C-y") 'emms-stream-yank-bookmark) - (define-key map (kbd "C-n") 'emms-stream-next-line) - (define-key map (kbd "C-p") 'emms-stream-previous-line) - (define-key map (kbd "Q") 'emms-stream-quit) - (define-key map (kbd "a") 'emms-stream-add-bookmark) - (define-key map (kbd "d") 'emms-stream-delete-bookmark) - (define-key map (kbd "e") 'emms-stream-edit-bookmark) - (define-key map (kbd "h") 'describe-mode) - (define-key map (kbd "n") 'emms-stream-next-line) - (define-key map (kbd "p") 'emms-stream-previous-line) - (define-key map (kbd "q") 'emms-stream-quit) - (define-key map (kbd "s") 'emms-stream-save-bookmarks-file) - (define-key map (kbd "t") 'emms-stream-toggle-default-action) -;; (define-key map (kbd "u") 'emms-stream-move-bookmark-up) - (define-key map (kbd "i") 'emms-stream-info-bookmark) - (define-key map (kbd "") 'emms-stream-previous-line) - (define-key map (kbd "") 'emms-stream-next-line) - (define-key map (kbd "") 'beginning-of-line) - (define-key map (kbd "") 'end-of-line) - (define-key map (kbd "RET") 'emms-stream-play) - map) - "Keymap for `emms-stream-menu'.") - -;;;###autoload -(defun emms-streams () - "Opens the EMMS Streams interface." - (interactive) - (kill-buffer (get-buffer-create emms-stream-buffer-name)) - (set-buffer (get-buffer-create emms-stream-buffer-name)) - (erase-buffer) - (when (string= emms-stream-default-action "play") - (emms-stream-create-playlist)) - (emms-stream-mode) - (switch-to-buffer emms-stream-buffer-name)) - -(defun emms-stream-mode () - (kill-all-local-variables) - (buffer-disable-undo) - (setq major-mode 'emms-stream-mode) - (setq mode-name "EMMS Streams") - (use-local-map emms-stream-mode-map) - (emms-stream-init) - (set (make-local-variable 'truncate-lines) t) - (set (make-local-variable 'automatic-hscrolling) t) - (set (make-local-variable 'kill-whole-line) t) - (set (make-local-variable 'next-line-add-newlines) nil) - (goto-char 1) - (emms-stream-display) - (toggle-read-only 1) - (run-hooks 'emms-stream-hook) - (set-buffer-modified-p nil) - (message "EMMS Stream Menu")) - -(defun emms-stream-create-playlist () - "Create a new EMMS playlist and associate it with emms-streams. -This is used when `emms-stream-default-action' is \"play\"." - (save-excursion - (setq emms-stream-playlist-buffer - (emms-playlist-set-playlist-buffer (emms-playlist-new))) - (with-current-buffer emms-stream-playlist-buffer - ;; if emms-stream-repeat-p is non-nil, make sure that we - ;; continue to play the station, even if briefly disconnected - (set (make-local-variable 'emms-repeat-playlist) - emms-stream-repeat-p)))) - -(defun emms-stream-kill-playlist () - "Delete the EMMS playlist associated with emms-streams, if one exists." - (when (buffer-live-p emms-stream-playlist-buffer) - (save-excursion - (if (eq emms-stream-playlist-buffer emms-playlist-buffer) - (emms-playlist-current-kill) - (kill-buffer emms-stream-playlist-buffer))) - (setq emms-stream-playlist-buffer nil))) - -(defun emms-stream-popup-revert () - "Revert to the window-configuration from before if there is one, -otherwise just remove the special bindings from the stream menu." - (interactive) - (remove-hook 'emms-pbi-manually-change-song-hook 'emms-pbi-popup-revert) - (let ((streambuffer (get-buffer emms-stream-buffer-name))) - (when streambuffer - (save-excursion - (set-buffer streambuffer) - ;; (local-unset-key (kbd "q")) - (local-unset-key (kbd "TAB"))))) - ;; (local-unset-key (kbd "RET"))))) - (when emms-stream-popup-old-conf - (set-window-configuration emms-stream-popup-old-conf)) - (remove-hook 'emms-stream-play-hook 'emms-stream-popup-revert) - (remove-hook 'emms-stream-quit-hook 'emms-stream-popup-revert)) - -(defun emms-stream-popup (&optional popup-height) - "Pops up the stream Menu, for the new stream selection. - -POPUP-HEIGHT is the height of the new frame, defaulting to -`emms-popup-default-height'." - (interactive) - (setq popup-height (or popup-height (/ (window-height) 2))) - ;; Split the current screen, and make the stream menu popup - (let ((new-window-height (- (window-height) popup-height))) - (if (not (> new-window-height 0)) - (error "Current window too small to popup menu!")) - ;; Save the current window-configuration - (setq emms-stream-popup-old-conf (current-window-configuration)) - ;; Split and select the menu - (let ((buffer-down - (split-window-vertically new-window-height))) - (select-window buffer-down)) - - (kill-buffer (get-buffer-create emms-stream-buffer-name)) - (switch-to-buffer (get-buffer-create emms-stream-buffer-name)) - (erase-buffer) - (emms-stream-mode) - - (add-hook 'emms-stream-play-hook 'emms-stream-popup-revert) - (add-hook 'emms-stream-quit-hook 'emms-stream-popup-revert) - (local-set-key (kbd "TAB") 'emms-stream-popup-revert) - (local-set-key (kbd "RET") 'emms-stream-play) - ;; (local-set-key (kbd "q") 'delete-window) - ;; Also, forget about the whole thing if the user does something - ;; to the window-configuration - ;; (add-hook 'window-configuration-change-hook 'emms-stream-popup-forget-conf))) - )) - -(defun emms-stream-init () - (setq emms-stream-list (emms-stream-read-file emms-stream-bookmarks-file))) - -(defun emms-stream-read-file (file) - "Returns a sexp." - (let ((file (expand-file-name file))) - (if (file-readable-p file) - (with-temp-buffer - (insert-file-contents-literally file) - (goto-char (point-min)) - (read (current-buffer))) - emms-stream-default-list))) - -(defun emms-stream-save-bookmarks-file () - (interactive) - (save-excursion - (let ((buffer (find-file-noselect emms-stream-bookmarks-file))) - (set-buffer buffer) - (erase-buffer) - (insert "(") - (let ((firstp t)) - (dolist (stream emms-stream-list) - (if (not firstp) - (insert "\n ") - (setq firstp nil)) - ;; make sure type identifier is a symbol, not a string - (when (stringp (nth 3 stream)) - (setq stream (copy-alist stream)) - (setcar (nthcdr 3 stream) (intern (nth 3 stream)))) - (prin1 stream buffer))) - (insert ")\n") - (save-buffer) - (kill-buffer buffer))) - (set-buffer-modified-p nil)) - -(defun emms-stream-display-line (line) - (insert (emms-stream-name line)) - (add-text-properties (point-at-bol) (point-at-eol) - '(face emms-stream-name-face)) - (add-text-properties (point-at-bol) (point-at-eol) `(emms-stream ,line)) - (insert "\n ") - (insert (emms-stream-url line)) - (add-text-properties (point-at-bol) (point-at-eol) - '(face emms-stream-url-face)) - (insert "\n")) - -(defun emms-stream-display () - "Displays the bookmark list in the current buffer, in a human - readable way." - (mapc 'emms-stream-display-line emms-stream-list) - (goto-char (point-min))) - -;; Helper functions -(defun emms-stream-take (n list) - "Takes N elements from LIST." - (let ((idx 0) - (res '())) - (while (< idx n) - (setq res (append res (list (nth idx list)))) - (setq idx (+ idx 1))) - res)) - -(defun emms-stream-insert-at (n elt list) - "Inserts the element ELT in LIST, *before* position N. -Positions are counted starting with 0." - (let* ((n-1 (- n 1)) - (before (emms-stream-take n-1 list)) - (after (last list (- (length list) n-1)))) - (append before (list elt) after))) - -(defun emms-stream-insert-several-at (n new-list list) - "Inserts the list NEW-LIST in LIST, *before* position N. -Positions are counted starting with 0." - (let* ((n-1 (- n 1)) - (before (emms-stream-take n-1 list)) - (after (last list (- (length list) n-1)))) - (append before new-list after))) - -(defun emms-stream-look-behind () - "Return non-nil if the position behind the point is an emms-stream." - (and (not (bobp)) - (get-text-property (1- (point)) 'emms-stream))) - -(defun emms-stream-back-to-stream () - "If we are not on a stream, move backwards to the nearest one." - (unless (get-text-property (point) 'emms-stream) - (unless (emms-stream-look-behind) - (goto-char (or (previous-single-property-change (point) 'emms-stream) - (point-min)))) - (goto-char (or (previous-single-property-change (point) 'emms-stream) - (point-min))))) - -(defun emms-stream-get-bookmark-at-point () - "Returns the bookmark under point." - (emms-stream-back-to-stream) - (get-text-property (point) 'emms-stream)) - -(defun emms-stream-redisplay () - (let ((inhibit-read-only t)) - (erase-buffer) - (goto-char (point-min)) - (emms-stream-display))) - -(defun emms-stream-determine-fd (name) - "Return a feed descriptor, given NAME. -This is the count of the times NAME appears in the bookmark list, -plus one." - (let ((count 1)) - (dolist (feed emms-stream-list) - (when (string= (emms-stream-name feed) name) - (setq count (1+ count)))) - count)) - -(defun emms-stream-add-bookmark (name url fd type) - "Creates a new bookmark, and inserts it at point position. - -Don't forget to run `emms-stream-save-bookmarks-file' after !" - (interactive - (list - (read-string "Name of the bookmark: ") - (read-string "URL: ") - nil - (completing-read - "Type (url, streamlist, or lastfm): " - (mapcar #'list '("url" "streamlist" "lastfm"))))) - (unless fd (setq fd (emms-stream-determine-fd name))) - (when (stringp type) (setq type (intern type))) - (let* ((line (emms-line-number-at-pos (point))) - (index (+ (/ line 2) 1))) - (setq emms-stream-list (emms-stream-insert-at index (list name url fd type) - emms-stream-list)) - (emms-stream-redisplay) - (goto-line line))) - -(defun emms-stream-delete-bookmark () - "Deletes the bookmark under the point. - -Don't forget to save your modifications !" - (interactive) - (let ((line (emms-line-number-at-pos (point)))) - (setq emms-stream-list - (delete (emms-stream-get-bookmark-at-point) emms-stream-list)) - (emms-stream-redisplay) - (goto-line line))) - -(defun emms-stream-edit-bookmark () - "Change the information of current bookmark." - (interactive) - (let* ((bookmark (emms-stream-get-bookmark-at-point)) - (name (read-from-minibuffer "Description: " - (emms-stream-name bookmark))) - (url (read-from-minibuffer "URL: " - (emms-stream-url bookmark))) - (fd (read-from-minibuffer "Feed Descriptor: " - (int-to-string (emms-stream-fd bookmark)))) - (type (read-from-minibuffer "Type (url, streamlist, or lastfm): " - (format "%s" (emms-stream-type bookmark))))) - (emms-stream-delete-bookmark) - (emms-stream-add-bookmark name url (string-to-number fd) type))) - -(defun emms-stream-name (el) - (car el)) -(defun emms-stream-url (el) - (cadr el)) -(defun emms-stream-fd (el) - (car (cddr el))) -(defun emms-stream-type (el) - (cadr (cddr el))) - -(defun emms-stream-play () - (interactive) - (let* ((line (or (get-text-property (point) 'emms-stream) - (progn - (goto-char (or (previous-single-property-change - (point) 'emms-stream) - (point-min))) - (goto-char (or (previous-single-property-change - (point) 'emms-stream) - (point-min))) - (get-text-property (point) 'emms-stream)) - (error "No stream found at point"))) - (name (emms-stream-name line)) - (url (emms-stream-url line)) - (fd (emms-stream-fd line)) - (type (emms-stream-type line)) - (player (read (concat "emms-" emms-stream-default-action "-" - (format "%s" type))))) - (setq emms-stream-last-stream line) -;; (funcall emms-stream-default-action url) - (funcall player url) - (if (string= emms-stream-default-action "add") - (message "URL added to playlist"))) - (later-do 'emms-mode-line-alter) - (run-hooks 'emms-stream-play-hook)) - -(defun emms-stream-info-bookmark () - "Return the station and track information for the streaming audio station under point." - (interactive) - (if (fboundp 'emms-stream-info-message) - (let* ((line (get-text-property (point) 'emms-stream)) - (url (emms-stream-url line))) - (emms-stream-info-message url)) - (message "Streaming media info not available."))) - -;; Killing and yanking -(defvar emms-stream-killed-streams () - "Bookmarks that have been killed.") - -(defun emms-stream-kill-bookmark () - "Kill the current bookmark." - (interactive) - (let ((stream (emms-stream-get-bookmark-at-point))) - (setq emms-stream-list (delete stream emms-stream-list) - emms-stream-killed-streams (cons stream emms-stream-killed-streams))) - (let ((inhibit-read-only t)) - (kill-line 2))) - -(defun emms-stream-yank-bookmark () - "Yank bookmark into the streams buffer." - (interactive) - (emms-stream-back-to-stream) - (let ((inhibit-read-only t) - (streams nil)) - ;; get all valid streams - (save-restriction - (narrow-to-region (point) (point)) - (yank) - (goto-char (point-min)) - (while (and (< (point) (point-max)) - (car emms-stream-killed-streams) - (looking-at "^\\(.+\\)\n \\(.+\\)\n")) - (setq streams (cons (car emms-stream-killed-streams) streams) - emms-stream-killed-streams (cdr emms-stream-killed-streams)) - (goto-char (match-end 0))) - (delete-region (point-min) (point-max))) - ;; insert streams into list - (if streams - (let* ((line (emms-line-number-at-pos (point))) - (index (+ (/ line 2) 1))) - (setq emms-stream-list (emms-stream-insert-several-at - index streams emms-stream-list)) - (setq line (+ line (* (length streams) 2))) - (emms-stream-redisplay) - (goto-line line)) - (message "Not yanking anything")))) - -;; Navigation -(defun emms-stream-next-line () - (interactive) - (when (get-text-property (point) 'emms-stream) - (goto-char (or (next-single-property-change (point) 'emms-stream) - (point-max)))) - (goto-char (or (next-single-property-change (point) 'emms-stream) - (point-max))) - (forward-line 0)) - -(defun emms-stream-previous-line () - (interactive) - (emms-stream-back-to-stream) - (goto-char (or (previous-single-property-change (point) 'emms-stream) - (point-min))) - (goto-char (or (previous-single-property-change (point) 'emms-stream) - (point-min))) - (forward-line 0)) - -(defun emms-stream-quit () - (interactive) - (emms-stream-kill-playlist) - (kill-this-buffer) - (run-hooks 'emms-stream-quit-hook)) - -(defun emms-stream-toggle-default-action () -"Toggle between adding to the current active playlist or play -right now (and thus erase the current active playlist)." - (interactive) - (if (string= emms-stream-default-action "play") - (progn - (emms-stream-kill-playlist) - (setq emms-stream-default-action "add") - (message "Default action is now add")) - (emms-stream-create-playlist) - (setq emms-stream-default-action "play") - (message "Default action is now play"))) - -;; info part -; (define-emms-info-method emms-info-url -; :providep 'emms-info-url-providep -; :get 'emms-info-url-get) -;; :set 'emms-info-url-set) - -;; A way to get the last element. it is either the only one, or the -;; last one added by emms-add-url. so in both cases, that's what we -;; want. -;; FIXME : not working with the new design. Yrk ? -; (defun emms-stream-last-element () -; (elt emms-playlist (- (length emms-playlist) 1))) - -(defun emms-info-url-providep (track) - (if (eq (emms-track-type track) 'url) - t - nil)) - -; (defun emms-info-url-get (track) -; (make-emms-info -; :title (emms-stream-url (emms-track-get track 'metadata)) -; :artist (emms-stream-name (emms-track-get track 'metadata)) -; :album " " -; :note " " -; :year " " -; :genre " " -; :file (emms-stream-url (emms-track-get track 'metadata)))) - -;; Then you register it with emms-info, by adding it to -;; `emms-info-methods-list'. - -; (add-to-list 'emms-info-methods-list 'emms-info-url) - -(defun emms-stream-add-data-to-track (track) - (emms-track-set track 'metadata emms-stream-last-stream)) - -(add-to-list 'emms-track-initialize-functions - 'emms-stream-add-data-to-track) - -; (when (featurep 'emms-info) -; (eval-when-compile (require 'emms-info)) ; appease byte-compiler -; (add-to-list 'emms-info-methods-list 'emms-info-streamlist) -; (defun emms-info-streamlist-providep (track) -; (if (eq (emms-track-type track) 'streamlist) -; t -; nil)) -; (define-emms-info-method emms-info-streamlist ;; FIXME-PLS ? -; :providep 'emms-info-streamlist-providep ;; FIXME-PLS ? -; :get 'emms-info-url-get)) - -(provide 'emms-streams) -;;; emms-streams.el ends here diff --git a/emms-tag-editor.el b/emms-tag-editor.el deleted file mode 100644 index 5f9d78e..0000000 --- a/emms-tag-editor.el +++ /dev/null @@ -1,742 +0,0 @@ -;;; emms-tag-editor.el --- Edit track tags. - -;; Copyright (C) 2006, 2007 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: - -;; Put this file into your load-path and the following into your ~/.emacs: -;; (require 'emms-tag-editor) - -;;; Code: - -(eval-when-compile - (require 'cl)) -(condition-case nil - (require 'overlay) - (error nil)) -(require 'emms) -(require 'emms-info-mp3info) -(require 'emms-playlist-mode) -(require 'emms-mark) -(require 'format-spec) - -(defvar emms-tag-editor-tags - '((info-artist . "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))) - ("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 - 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" "mp3info" - ((info-artist . "a") - (info-title . "t") - (info-album . "l") - (info-tracknumber . "n") - (info-year . "y") - (info-genre . "g") - (info-note . "c"))) - ("ogg" . emms-tag-editor-tag-ogg) - ("flac" . emms-tag-editor-tag-flac)) - "An alist used when committing changes to tags in files. -If the external program sets tags by command line options -one-by-one such as mp3info, 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 OGG file according to TRACK." - (require 'emms-info-metaflac) - (with-temp-buffer - (let (need 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")))) - '("artist" "composer" "performer" "title" "album" "tracknumber" "date" "genre" "note")) - (when (buffer-string) - (funcall #'call-process-region (point-min) (point-max) - emms-info-metaflac-program-name nil - (get-buffer-create emms-tag-editor-log-buffer) - nil - "--import-tags-from=-" - (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 "vorbiscomment" 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) - "Change TAGS in FILE, using PROGRAM. -Valid tags are given by `emms-tag-editor-tagfile-functions'." - (let (args val) - (mapc (lambda (tag) - (setq val (emms-track-get track (car tag))) - (if (and val (stringp val)) - (setq args (append (list (concat "-" (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)) - (save-excursion - (set-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-edit-track (track) - "Edit the track at point, or TRACK." - (interactive (list (emms-tag-editor-track-at))) - (if (null track) - (message "No track at point!") - (emms-tag-editor-insert-tracks (list track)))) - -(defun emms-tag-editor-edit-marked-tracks () - "Edit all tracks marked in the current buffer." - (interactive) - (let ((tracks (emms-mark-mapcar-marked-track 'emms-tag-editor-track-at t))) - (if (null tracks) - (message "No track marked!") - (emms-tag-editor-insert-tracks tracks)))) - -(defun emms-tag-editor-edit () - "Edit tags of either the track at point or all marked tracks." - (interactive) - (if (emms-mark-has-markedp) - (emms-tag-editor-edit-marked-tracks) - (emms-tag-editor-edit-track (emms-tag-editor-track-at)))) - -(defvar emms-tag-editor-mode-map - (let ((map (make-sparse-keymap))) - (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 (completing-read "Set tag: " - 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)) nil t) - (skip-chars-forward " \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 (completing-read "Replace in tag: " - 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)))) - (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" match to)) - (lambda (match) - (delete-region (- (point) (length match)) (point)) - (insert to)) - (lambda () - (if (and (save-excursion - (re-search-backward tag (line-beginning-position) t)) - (re-search-forward from (line-end-position) t)) - (match-string 0) - (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 (match-string 0)))))))) - (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 (completing-read "Tag 1: " - emms-tag-editor-tags nil t))) - (tag2 (intern (completing-read "Tag 2: " - (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) - (save-excursion - (set-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)) - (add-to-list 'registers (cons register index))) - (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))) - (if 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) - (eq (emms-track-get track 'type) 'file) - (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 - ;; 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 (boundp '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 mp3info to change tag in mp3 file - (when (and (eq (emms-track-get track 'type) 'file) - (file-writable-p (emms-track-name track)) - (setq func (assoc (file-name-extension filename) - emms-tag-editor-tagfile-functions))) - (setq exit - (if (functionp (cdr func)) - (funcall (cdr func) track) - (emms-tag-editor-tag-file track (cadr func) (nth 2 func)))) - (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)))) - (if (and (featurep 'emms-cache) - need-sync - (y-or-n-p "You have changed some track names; sync the cache? ")) - (and (fboundp 'emms-cache-sync) ; silence byte-compiler - (emms-cache-sync))) - (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 (eq (emms-track-get track 'type) 'file) - (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) - -(provide 'emms-tag-editor) -;;; Emms-tag-editor.el ends here diff --git a/emms-url.el b/emms-url.el deleted file mode 100644 index 99d7ad7..0000000 --- a/emms-url.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; emms-url.el --- Make URL and EMMS work together well - -;; Copyright (C) 2006, 2007 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-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/emms-volume-amixer.el b/emms-volume-amixer.el deleted file mode 100644 index 6bee5ab..0000000 --- a/emms-volume-amixer.el +++ /dev/null @@ -1,67 +0,0 @@ -;;; emms-volume-amixer.el --- a mode for changing volume using amixer - -;; Copyright (C) 2006, 2007 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. - -;;; 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-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) - -;;;###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 - "sset" emms-volume-amixer-control - (format "%d%%%s" (abs amount) - (if (< amount 0) "-" "+")))) - (if (re-search-backward "\\[\\([0-9]+%\\)\\]" nil t) - (match-string 1)))))) - -(provide 'emms-volume-amixer) - -;;; emms-volume-amixer.el ends here diff --git a/emms-volume.el b/emms-volume.el deleted file mode 100644 index f894976..0000000 --- a/emms-volume.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; emms-volume.el --- Volume functions and a minor mode to adjust volume easily - -;; Copyright (C) 2006, 2007 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 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) - -;; Customize group -(defgroup emms-volume nil - "Volume setting for EMMS." - :group 'emms) - -;; General volume setting related code. -(defcustom emms-volume-change-function 'emms-volume-amixer-change - "*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) - (function :tag "Lisp function")) - :group 'emms-volume) - -(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 - :group 'emms-volume) - -;;;###autoload -(defun emms-volume-raise () - "Raise the speaker volume." - (interactive) - (funcall emms-volume-change-function emms-volume-change-amount)) - -;;;###autoload -(defun emms-volume-lower () - "Lower the speaker 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/emms.el b/emms.el deleted file mode 100644 index 4825cbd..0000000 --- a/emms.el +++ /dev/null @@ -1,1391 +0,0 @@ -;;; emms.el --- The Emacs Multimedia System - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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 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, so you might -;; just want to use that file. - -;;; Code: - -(defvar emms-version "3.0" - "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. You need to set this!" - :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-repeat-track nil - "Non-nil, playback will repeat current track. If nil, EMMS will play -track by track normally." - :group 'emms - :type 'boolean) - -(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 make track uniq 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 default-major-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-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-updated-functions nil - "*List of functions to call when a track changes data. -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. -This is a number in seconds." - :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 "~/.emacs.d/emms" - "*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.") - - -;;; 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. -The point will be placed at the beginning of the track before -executing BODY. - -The 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)) - - -;;; 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)) - ((condition-case nil - (progn - (emms-playlist-current-select-next) - t) - (error nil)) - (emms-start)) - (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." - (interactive) - (when emms-player-playing-p - (emms-player-pause))) - -(defun emms-seek (seconds) - "Seek the current player SECONDS seconds. -This can be a floating point number for sub-second fractions. -It can also be negative to seek backwards." - (interactive "nSeconds to seek: ") - (emms-ensure-player-playing-p) - (emms-player-seek seconds)) - -(defun emms-seek-to (seconds) - "Seek the current player to SECONDS seconds. -This can be a floating point number for sub-second fractions. -It can also be negative to seek backwards." - (interactive "nSeconds to seek to: ") - (emms-ensure-player-playing-p) - (emms-player-seek-to 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 () - "Uniq the current playlist. -This uses `emms-playlist-uniq-function'." - (interactive) - (with-current-emms-playlist - (save-excursion - (funcall emms-playlist-uniq-function)))) - -(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"))) - - -;;; Compatibility functions - -(require 'emms-compat) - - -;;; 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-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." - (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)))) - - -;;; 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 when 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))) - (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 (sort buf-list - #'(lambda (lbuf rbuf) - (< (length (car lbuf)) - (length (car rbuf))))))))) - (completing-read "Playlist buffer to make current: " - 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 (interactive-p) - (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 (interactive-p) - (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. -If no playlist exists, a new one is generated." - (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 when 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 anyways, 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" - (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))))) - -;;; 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' -do 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 `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-player-start (track) - "Start playing TRACK." - (if emms-player-playing-p - (error "A player is already playing") - (let ((player (emms-player-for track))) - (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 diff --git a/jack.el b/jack.el deleted file mode 100644 index e1e53fd..0000000 --- a/jack.el +++ /dev/null @@ -1,368 +0,0 @@ -;;; jack.el --- Jack Audio Connection Kit support - -;; Copyright (C) 2005, 2006, 2007 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 jack () - "Jack Audio Connection Kit" - :group 'processes) - -(defcustom jack-rc '("~/.jackdrc" "/etc/jackd.conf") - "*JACK run control paths." - :group 'jack - :type 'repeat) - -(defcustom 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." - :group 'jack - :type 'boolean) - -(defcustom jack-program (executable-find "jackd") - "*JACK executable path." - :group 'jack - :type 'file) - -(defcustom jack-sample-rate 44100 - "*Default sampling rate for JACK." - :group 'jack - :type 'integer) - -(defcustom jack-period-size 128 - "*Period size to use when launching new JACK process." - :group 'jack - :type 'integer) - -(defcustom jack-alsa-device nil - "*ALSA soundcard to use." - :group 'jack - :type '(choice (const :tag "Ask" nil) string)) - -(defun 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 jack-alsa-device () - (or jack-alsa-device (jack-read-alsa-device))) - -(defcustom jack-output-buffer-name "*JACK output*" - "*Output buffer name." - :group 'jack - :type 'string) - -(defun jack-args () - "Return a list of startup arguments to use. -First element is the executable path." - (or (and jack-use-jack-rc - (catch 'rc-found - (let ((files (mapcar 'expand-file-name 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 jack-program - "-v" - "-R" - "-dalsa" - (format "-d%s" (jack-alsa-device)) - (format "-r%d" jack-sample-rate) - (format "-p%d" jack-period-size)))) - -(defcustom jack-set-rtlimits t - "*Use set_rtlimits (if available) to gain realtime priorities if -R -is given in jackd command-line." - :group 'jack - :type 'boolean) - -(defcustom jack-set-rtlimits-program (executable-find "set_rtlimits") - "*Path to set_rtlimits." - :group 'jack - :type 'file) - -(defun jack-maybe-rtlimits (args) - (if (and jack-set-rtlimits - (or (member "-R" args) (member "--realtime" args)) - (file-exists-p jack-set-rtlimits-program)) - (append (list jack-set-rtlimits-program "-r") args) - args)) - -(defvar jack-process nil) - -(defvar jack-load 0) - -(defvar jack-max-usecs 0) - -(defvar jack-spare 0) - -(defun jack-output-buffer () - (or (get-buffer jack-output-buffer-name) - (with-current-buffer (get-buffer-create jack-output-buffer-name) - (setq major-mode 'jack-mode - mode-name "JACK" - mode-line-format (copy-tree mode-line-format)) - (setcar (nthcdr 16 mode-line-format) - `(:eval (format "load:%.2f" jack-load))) - (add-hook 'kill-buffer-hook 'jack-kill nil t) - (current-buffer)))) - -(defvar jack-xruns nil) - -(defun 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 jack-load (string-to-number (match-string 1 string)) - jack-max-usecs (string-to-number (match-string 2 string)) - 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)) jack-xruns) - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point)))))) - (when moving (goto-char (process-mark proc)))))) - -(defun jack-running-p () - (and jack-process (processp jack-process) - (eq (process-status jack-process) 'run))) - -(defcustom jack-started-hook nil - "*Hook run when `jack-start' successfully started a new JACK intance." - :group 'jack - :type 'hook) - -(defun jack-start () - "Start the JACK process." - (interactive) - (if (jack-running-p) (error "JACK already running") - (setq jack-process - (apply 'start-process "jack" (jack-output-buffer) - (jack-maybe-rtlimits (jack-args)))) - (set-process-filter jack-process #'jack-filter) - (run-hooks 'jack-started-hook) - (switch-to-buffer (jack-output-buffer)))) - -(defun jack-kill () - "Kill the currently running JACK process." - (interactive) - (when (jack-running-p) (delete-process jack-process)) - (setq jack-process nil)) - -(defun jack-restart () - "Restart JACK." - (interactive) - (if (jack-running-p) (jack-kill)) - (sit-for 0) - (jack-start)) - -(defun 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 jack-ports (program) - (cdr (assoc program (jack-list)))) - -(defun jack-get-port-connections (program port) - (cdr (assoc 'connections (cdr (assoc port (jack-ports program)))))) - -(defun jack-get-port-properties (program port) - (cdr (assoc 'properties (cdr (assoc port (jack-ports program)))))) - -(defun jack-get-direction (program port) - (let ((props (jack-get-port-properties program port))) - (or (car (member 'output props)) - (car (member 'input props)) - (error "Neither input nor output port")))) - -(defun jack-read-program (prompt &optional predicate) - (let ((progs (if (functionp predicate) - (emms-remove-if-not predicate (jack-list)) - (jack-list)))) - (unless progs (error "No matching JACK clients found")) - (if (< (length progs) 2) (caar progs) - (completing-read prompt progs nil t)))) - -(defun 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 jack-read-port (program prompt &optional predicate) - (let ((ports (if (functionp predicate) - (emms-remove-if-not predicate (jack-ports program)) - (jack-ports program)))) - (if (< (length ports) 2) (caar ports) - (completing-read prompt ports nil t (jack-unique-port-name (mapcar 'car ports)))))) - -(defun 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 (jack-read-program "Connect: ")) - (port (jack-read-port prog (format "Connect %s port: " prog))) - (to-type (if (eq (jack-get-direction prog port) 'input) 'output 'input)) - (to-prog (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 (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 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 (jack-read-program - "Disconnect: " - (lambda (prog) - (emms-find-if (lambda (port) (assoc 'connections (cdr port))) - (cdr prog))))) - (port (jack-read-port prog - (format "Disconnect %s port: " prog) - (lambda (port) - (assoc 'connections (cdr port))))) - (connections (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 (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 'jack) -;;; jack.el ends here diff --git a/later-do.el b/later-do.el deleted file mode 100644 index ecc4197..0000000 --- a/later-do.el +++ /dev/null @@ -1,76 +0,0 @@ -;;; later-do.el --- execute lisp code ... later - -;; Copyright (C) 2004, 2005, 2006, 2007 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. - -;;; Code: - -(defvar later-do-version "0.2emms2 (2005-09-20)" - "Version string of later-do.") - -(defgroup later-do nil - "*Running functions ... later!" - :prefix "later-do-" - :group 'development) - -(defcustom later-do-interval 0.5 - "How many seconds to wait between running events." - :group 'later-do - :type 'number) - -(defvar later-do-list nil - "A list of functions to be called lateron.") - -(defvar later-do-timer nil - "The timer that later-do uses.") - -(defun 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 `later-do' is guaranteed to be executed in the -sequence it was added." - (setq later-do-list (nconc later-do-list - (list (cons function args)))) - (unless later-do-timer - (setq later-do-timer - (run-with-timer later-do-interval nil 'later-do-timer)))) - -(defun later-do-timer () - "Run the next element in `later-do-list', or do nothing if it's -empty." - (if (null later-do-list) - (setq later-do-timer nil) - (let ((fun (caar later-do-list)) - (args (cdar later-do-list))) - (setq later-do-list (cdr later-do-list)) - (unwind-protect - (apply fun args) - (setq later-do-timer (run-with-timer later-do-interval - nil - 'later-do-timer)))))) - -(provide 'later-do) -;;; later-do.el ends here diff --git a/lisp/Makefile b/lisp/Makefile new file mode 100644 index 0000000..3153b9b --- /dev/null +++ b/lisp/Makefile @@ -0,0 +1,28 @@ +EMACS=emacs +SITEFLAG=--no-site-file +ALLSOURCE=$(wildcard *.el) +ALLCOMPILED=$(wildcard *.elc) +SPECIAL=emms-auto.el emms-maint.el +SOURCE=$(filter-out $(SPECIAL),$(ALLSOURCE)) +TARGET=$(patsubst %.el,%.elc,$(SOURCE)) + +.PHONY: all clean +.PRECIOUS: %.elc +all: $(TARGET) emms-auto.el + +emms-auto.el: emms-auto.in $(SOURCE) + cp emms-auto.in emms-auto.el + -rm -f emms-auto.elc + @$(EMACS) -q $(SITEFLAG) -batch \ + -l emms-maint.el \ + -l emms-auto.el \ + -f generate-autoloads \ + $(shell pwd)/emms-auto.el . + +%.elc: %.el + @$(EMACS) -q $(SITEFLAG) -batch \ + -l emms-maint.el \ + -f batch-byte-compile $< + +clean: + -rm -f *~ *.elc emms-auto.el diff --git a/lisp/emms-auto.in b/lisp/emms-auto.in new file mode 100644 index 0000000..78c71ef --- /dev/null +++ b/lisp/emms-auto.in @@ -0,0 +1,13 @@ +;;; -*-emacs-lisp-*- + +(defvar generated-autoload-file) +(defvar command-line-args-left) +(defun generate-autoloads () + (interactive) + (require 'autoload) + (setq generated-autoload-file (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left)) + (batch-update-autoloads)) + +(provide 'emms-auto) +;;; Generated autoloads follow (made by autoload.el). diff --git a/lisp/emms-bookmarks.el b/lisp/emms-bookmarks.el new file mode 100644 index 0000000..c470bc3 --- /dev/null +++ b/lisp/emms-bookmarks.el @@ -0,0 +1,153 @@ +;;; emms-bookmarks.el --- Bookmarks for Emms. + +;; Copyright (C) 2006, 2007 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) +;; into 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 promting 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/lisp/emms-browser.el b/lisp/emms-browser.el new file mode 100644 index 0000000..f8760f8 --- /dev/null +++ b/lisp/emms-browser.el @@ -0,0 +1,1959 @@ +;;; emms-browser.el --- a track browser supporting covers and filtering + +;; Copyright (C) 2006, 2007 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) + +;; Key bindings +;; ------------------------------------------------------------------- + +;; C-j emms-browser-add-tracks-and-play +;; RET emms-browser-add-tracks +;; SPC emms-browser-toggle-subitems +;; / emms-isearch-buffer +;; 1 emms-browser-collapse-all +;; 2 emms-browser-expand-to-level-2 +;; 3 emms-browser-expand-to-level-3 +;; 4 emms-browser-expand-to-level-4 +;; < emms-browser-previous-filter +;; > emms-browser-next-filter +;; ? describe-mode +;; C emms-browser-clear-playlist +;; E emms-browser-expand-all +;; d emms-browser-view-in-dired +;; d emms-browser-delete-files +;; q emms-browser-bury-buffer +;; r emms-browser-goto-random +;; n next-line +;; p previous-line +;; C-/ emms-playlist-mode-undo +;; emms-browser-add-tracks-and-play +;; emms-browser-prev-non-track +;; emms-browser-next-non-track + +;; s A emms-browser-search-by-album +;; s a emms-browser-search-by-artist +;; s c emms-browser-search-by-composer +;; s s emms-browser-search-by-names +;; s t emms-browser-search-by-title +;; s p emms-browser-search-by-performer + +;; b 1 emms-browse-by-artist +;; b 2 emms-browse-by-album +;; b 3 emms-browse-by-genre +;; b 4 emms-browse-by-year +;; b 5 emms-browse-by-composer +;; b 6 emms-browse-by-performer + +;; W a p emms-browser-lookup-album-on-pitchfork +;; W a w emms-browser-lookup-album-on-wikipedia + +;; W A p emms-browser-lookup-artist-on-pitchfork +;; W A w emms-browser-lookup-artist-on-wikipedia + +;; W C p emms-browser-lookup-composer-on-pitchfork +;; W C w emms-browser-lookup-composer-on-wikipedia + +;; W P p emms-browser-lookup-performer-on-pitchfork +;; W P w emms-browser-lookup-performer-on-wikipedia + +;; 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. + +;; (defadvice emms-browser-next-mapping-type +;; (after no-album (current-mapping)) +;; (when (eq ad-return-value 'info-album) +;; (setq ad-return-value 'info-title))) + +;; (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 'emms) +(require 'emms-cache) +(require 'emms-source-file) +(require 'emms-playlist-sort) +(require 'sort) + +(eval-when-compile + (require 'cl)) + +;; -------------------------------------------------- +;; Variables and configuration +;; -------------------------------------------------- + +(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." + :group 'emms-browser + :type 'function) + +(defcustom emms-browser-make-name-function + 'emms-browser-make-name-standard + "*A function to make names for entries and subentries. +Overriding this function allows you to customise how various elements +are displayed. It is called with two arguments - track and type." + :group 'emms-browser + :type 'function) + +(defcustom emms-browser-get-track-field-function + 'emms-browser-get-track-field-simple + "*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." + :group 'emms-browser + :type 'function) + +(defcustom emms-browser-covers + '("cover_small.jpg" "cover_med.jpg" "cover_large.jpg") + "*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." + :group 'emms-browser + :type '(choice list function boolean)) + +(defcustom emms-browser-default-covers nil + "*A list of default images to use if a cover isn't found." + :group 'emms-browser + :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." + :group 'emms-browser + :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." + :group 'emms-browser + :type 'function) + +(defcustom emms-browser-alpha-sort-function + 'string< + "*How to sort artists/albums/etc. in the browser. +Use nil for no sorting." + :group 'emms-browser + :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." + :group 'emms-browser + :type 'function) + +(defcustom emms-browser-show-display-hook nil + "*Hooks to run when starting or switching to a browser buffer." + :group 'emms-browser + :type 'hook) + +(defcustom emms-browser-hide-display-hook nil + "*Hooks to run when burying or removing a browser buffer." + :group 'emms-browser + :type 'hook) + +(defcustom emms-browser-tracks-added-hook nil + "*Hooks to run when tracks are added to the playlist." + :group 'emms-browser + :type 'hook) + +(defcustom emms-browser-filter-tracks-hook nil + "*Given a track, return t if the track should be ignored." + :group 'emms-browser + :type 'hook) + +(defcustom emms-browser-filter-changed-hook nil + "*Hook run after the filter has changed." + :group 'emms-browser + :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." + :group 'emms-browser + :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-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-hash) + +(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.") + +(defconst 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 "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-next-non-track) + (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 A p") 'emms-browser-lookup-artist-on-pitchfork) + (define-key map (kbd "W C w") 'emms-browser-lookup-composer-on-wikipedia) + (define-key map (kbd "W C p") 'emms-browser-lookup-composer-on-pitchfork) + (define-key map (kbd "W P w") 'emms-browser-lookup-performer-on-wikipedia) + (define-key map (kbd "W P p") 'emms-browser-lookup-performer-on-pitchfork) + (define-key map (kbd "W a w") 'emms-browser-lookup-album-on-wikipedia) + (define-key map (kbd "W a p") 'emms-browser-lookup-album-on-pitchfork) + (define-key map (kbd ">") 'emms-browser-next-filter) + (define-key map (kbd "<") 'emms-browser-previous-filter) + map) + "Keymap for `emms-browser-mode'.") + +(defconst 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) + (defalias 'emms-browser-with-selected-window 'with-selected-window) + (defmacro emms-browser-with-selected-window (window &rest body) + ;; 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)) + + (if (fboundp 'run-mode-hooks) + (defalias 'emms-browser-run-mode-hooks 'run-mode-hooks) + (defalias 'emms-browser-run-mode-hooks 'run-hooks))) + +;; -------------------------------------------------- +;; General mode setup +;; -------------------------------------------------- + +(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)))) + +(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." + (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) + (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)) + (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)) + (sort-lines nil (point-min) (point-max))))) + +(defun case-fold-string= (a b) + (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-year-number (track) + "Return a string representation of a track's year. +This will be in the form '(1998) '." + (let ((year (emms-track-get track 'info-year))) + (if (or (not (stringp year)) (string= year "0")) + "" + (concat + "(" year ") ")))) + +(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'." + `(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'." + `(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 (point-at-bol) + '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." + (let ((moved nil) + (continue t) + (current-level (emms-browser-level-at-point))) + (while (and + continue + (zerop (forward-line + (or direction -1)))) + (when (> current-level (emms-browser-level-at-point)) + (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) + (assert (emms-browser-move-up-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 (point-at-bol 2))) + (emms-with-inhibit-read-only-t + (delete-region next-line + (save-excursion + (while + (emms-browser-find-entry-more-than-level + current-level)) + (point-at-bol 2))))))) + +;; -------------------------------------------------- +;; Dealing with the playlist (queuing songs, etc) +;; -------------------------------------------------- + +(defun emms-browser-playlist-insert-group (bdata) + "Insert a group description into the playlist buffer." + (let* ((type (emms-browser-bdata-type bdata)) + (short-type (substring (symbol-name type) 5)) + (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)) + (track (car (emms-browser-bdata-data bdata)))) + (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)) + (name (emms-browser-bdata-name 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." + (goto-char (point-min)) + (while (not (eq (buffer-end 1) (point))) + (if (< (emms-browser-level-at-point) level) + (emms-browser-show-subitems)) + (emms-browser-next-non-track)) + (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 (point-at-bol) + (point-at-eol) + (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 (point-at-bol) + (point-at-eol) + (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 (point-at-bol)) + (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. +Return the previous point-max before adding." + (interactive) + (let ((first-new-track (with-current-emms-playlist (point-max))) + (bdata (emms-browser-bdata-at-point))) + (emms-browser-playlist-insert-bdata + bdata (emms-browser-bdata-level bdata)) + (run-hook-with-args 'emms-browser-tracks-added-hook + first-new-track) + 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))))) + +(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 () + (interactive) + (when emms-browser-seed-pending + (random t) + (setq emms-browser-seed-pending nil)) + (goto-line (random (count-lines (point-min) (point-max))))) + +(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-delete-files () + "Delete all files under point. +Disabled by default." + (interactive) + (let ((tracks (emms-browser-tracks-at-point)) + dirs path) + (unless (yes-or-no-p + (format "Really permanently delete these %d tracks? " + (length tracks))) + (error "Cancelled!")) + (message "Deleting files..") + (dolist (track tracks) + (setq path (emms-track-get track 'name)) + (delete-file path) + (add-to-list 'dirs (file-name-directory path)) + (emms-cache-del path)) + ;; remove empty dirs + (dolist (dir dirs) + (run-hook-with-args 'emms-browser-delete-files-hook dir tracks) + (condition-case nil + (delete-directory dir) + (error nil))) + ;; remove the item from the browser + (emms-browser-delete-current-node) + (message "Deleting files..done"))) + +(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-pitchfork (field) + (emms-browser-lookup + field "http://www.pitchforkmedia.com/search/record_reviews/query?query[keywords]=")) + +(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)) + +(defun emms-browser-lookup-artist-on-pitchfork () + (interactive) + (emms-browser-lookup-pitchfork 'info-artist)) + +(defun emms-browser-lookup-composer-on-pitchfork () + (interactive) + (emms-browser-lookup-pitchfork 'info-composer)) + +(defun emms-browser-lookup-performer-on-pitchfork () + (interactive) + (emms-browser-lookup-pitchfork 'info-performer)) + +(defun emms-browser-lookup-album-on-pitchfork () + (interactive) + (emms-browser-lookup-pitchfork '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." + :group 'emms-browser + :type 'boolean) + +(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-to-list 'emms-browser-show-display-hook + 'emms-browser-display-playlist) + (add-to-list 'emms-browser-hide-display-hook + 'emms-browser-hide-linked-window) + ;; switch to the playlist window when adding tracks? + (add-to-list '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 buf) + (cond + ((eq major-mode 'emms-browser-mode) + (setq buf (emms-browser-get-linked-buffer)) + (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)) + ;; 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-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)) + (when (string-match (cadr item) + (emms-track-get 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*")) + (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-get-cover-from-album (bdata &optional size) + (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)) + (concat (file-name-directory path) + (nth size-idx emms-browser-covers)))))) + (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)) ?\ ))) + +(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 track 'info-year)) + ("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)) + ("T" . ,(emms-browser-track-number track)) + ("cS" . ,(emms-browser-get-cover-str path 'small)) + ("cM" . ,(emms-browser-get-cover-str path 'medium)) + ("cL" . ,(emms-browser-get-cover-str path 'large)))) + str) + + (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 (cdr (assoc spec specification)))) + (unless val + (error "Invalid format character: %s" spec)) + ;; 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.") + :group 'emms-browser-mode))) + +(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 (path) + "Generate a function which checks if a track is in path. +If the track is not in path, return t." + `(lambda (track) + (not (string-match ,(concat "^" (expand-file-name path)) + (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 (quote ,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)))))) + +(provide 'emms-browser) +;;; emms-browser.el ends here diff --git a/lisp/emms-cache.el b/lisp/emms-cache.el new file mode 100644 index 0000000..9c6ae5f --- /dev/null +++ b/lisp/emms-cache.el @@ -0,0 +1,180 @@ +;;; emms-cache.el --- persistence for emms-track + +;; Copyright (C) 2006, 2007 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: + +;; 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 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 + (add-hook 'after-init-hook 'emms-cache-restore) + (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 'after-init-hook 'emms-cache-restore) + (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." + (gethash path emms-cache-db)) + +;; Note we ignore TYPE, as it's stored in TRACK +(defun emms-cache-set (type path track) + "Set PATH to TRACK in the cache." + (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...") + (set-buffer (get-buffer-create " emms-cache ")) + (erase-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)) + (write-region (point-min) (point-max) emms-cache-file) + (kill-buffer (current-buffer)) + (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 () + "Sync the cache with the data on disc. +Remove non-existent files, and update data for files which have +been modified." + (interactive) + (message "Syncing emms track cache...") + (let (removed) + (maphash (lambda (path track) + (when (eq (emms-track-get track 'type) 'file) + ;; 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)) + (run-hook-with-args 'emms-info-functions track)))))) + emms-cache-db) + (when removed + (setq emms-cache-dirty t))) + (message "Syncing emms track cache...done")) + +(provide 'emms-cache) +;;; emms-cache.el ends here diff --git a/lisp/emms-compat.el b/lisp/emms-compat.el new file mode 100644 index 0000000..74ecb48 --- /dev/null +++ b/lisp/emms-compat.el @@ -0,0 +1,162 @@ +;;; emms-compat.el --- Compatibility routines for EMMS + +;; Copyright (C) 2005, 2006, 2007 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." + (condition-case nil + (make-obsolete old-name new-name when) + (wrong-number-of-arguments (make-obsolete old-name new-name)))) + + +;;; 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))))) + + +;;; 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/lisp/emms-history.el b/lisp/emms-history.el new file mode 100644 index 0000000..47d2e73 --- /dev/null +++ b/lisp/emms-history.el @@ -0,0 +1,125 @@ +;;; emms-history.el -- save all playlists when exiting emacs + +;; Copyright (C) 2006, 2007 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) +(eval-when-compile + (require 'cl)) + +(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 + :group 'emms-history) + +(defcustom emms-history-start-playing nil + "If non-nil emms starts playing the current track after +`emms-history-load' was invoked." + :type 'boolean + :group 'emms-history) + +(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 "(\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)))))) + +(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 + (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)) + (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/lisp/emms-i18n.el b/lisp/emms-i18n.el new file mode 100644 index 0000000..ac54eff --- /dev/null +++ b/lisp/emms-i18n.el @@ -0,0 +1,164 @@ +;;; emms-i18n.el --- Function for handling coding system + +;; Copyright (C) 2006, 2007 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 read from process, first check the CAR part of +;; `emms-i18n-default-coding-system', if non-nil, use this for decode, and +;; nerver detect coding system, if nil, first call +;; `emms-i18n-coding-dectect-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-nerver-used-coding-system', decode it, otherwise use +;; locale-coding-system. +;; +;; When write send 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) +(eval-when-compile + (require 'cl)) + +;; TODO: Change these to use defcustom + +(defvar emms-i18n-nerver-used-coding-system + '(raw-text undecided) + "If the `emms-i18n-coding-dectect-functions' return coding system in +this list, use `emms-i18n-default-coding-system' instead.") + +(defvar emms-i18n-coding-system-for-read 'utf-8 + "If coding detect failed, use this for decode") + +(defvar emms-i18n-default-coding-system nil + "If non-nil, used for decode and encode") + +(defvar emms-i18n-coding-dectect-functions nil + "A list of function to call to detect codings") + +(defvar emms-i18n-detect-max-size 10000 + "Max bytes to detect coding system. Nil mean scan whole buffer.") + +(defun emms-i18n-iconv (from to str) + "Convert 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) + (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 read is %S." (car emms-i18n-default-coding-system)) + "Good, you want detect coding system by me!") + (format " The coding system for write is %S." + (or (cdr emms-i18n-default-coding-system) + (cdr default-process-coding-system)))))) + +(defun emms-i18n-call-process-simple (&rest args) + "This function run program and return the program result. If the CAR +part of `emms-i18n-default-coding-system' is non-nil, the program result will +be decode use the CAR part of emms-i18n-default-coding-system. Otherwise, +use `emms-i18n-coding-dectect-functions' to detect the coding system of the +result. If the emms-i18n-coding-dectect-functions failed, use +`emms-i18n-detect-coding-function' to detect coding system. If all the +coding system is nil or in `emms-i18n-nerver-used-coding-system', decode +the result using `emms-i18n-coding-system-for-read'. + +The rest arguments ARGS is as the same as `call-process', except the +BUFFER should always have value t. Otherwise the coding detection will +not perform." + (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) + (null (car emms-i18n-default-coding-system))) + (save-restriction + (narrow-to-region pos (point)) + (decode-coding-region (point-min) (point-max) (emms-i18n-detect-buffer-coding-system)))) + exit)) + +;; Is this function useful? +(defun emms-i18n-call-process (&rest args) + "Run the program like `call-process'. If +the cdr part `emms-i18n-default-coding-system' is non-nil, the string in +ARGS will be encode by the CDR part of `emms-i18n-default-coding-system', +otherwise, it is pass all parameter 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 call this function, make sure the buffer is literal" + (let ((size (- (point-max) (point-min))) + (func (append emms-i18n-coding-dectect-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-nerver-used-coding-system) + (setq coding (emms-i18n-detect-coding-function size)))) + (if (or (null coding) (member (coding-system-base coding) emms-i18n-nerver-used-coding-system)) + emms-i18n-coding-system-for-read + coding)))) + +;;; emms-i18n.el ends here diff --git a/lisp/emms-info-libtag.el b/lisp/emms-info-libtag.el new file mode 100644 index 0000000..96c7613 --- /dev/null +++ b/lisp/emms-info-libtag.el @@ -0,0 +1,81 @@ +;;; emms-info-libtag.el --- Info-method for EMMS using libtag + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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-to-list '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)) + +;;; Code: + +(require 'emms-info) + +(defvar emms-info-libtag-coding-system 'utf-8) +(defvar emms-info-libtag-program-name "emms-print-metadata") + +(defun emms-info-libtag (track) + (when (and (eq 'file (emms-track-type track)) + (string-match + "\\.\\([Mm][Pp]3\\|[oO][gG][gG]\\|[fF][lL][aA][cC]\\|[sS][pP][xX]\\)\\'" + (emms-track-name track))) + (with-temp-buffer + (when (zerop + (let ((coding-system-for-read 'utf-8)) + (call-process "emms-print-metadata" + nil t 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/lisp/emms-info-metaflac.el b/lisp/emms-info-metaflac.el new file mode 100644 index 0000000..fe94db0 --- /dev/null +++ b/lisp/emms-info-metaflac.el @@ -0,0 +1,107 @@ +;;; emms-info-metaflac.el --- Info-method for EMMS using metaflac + +;; Copyright (C) 2006 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-to-list 'emms-info-methods-list 'emms-info-metaflac) + +;;; Code: + +(eval-when-compile (require 'cl)) +(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 + :group 'emms-info-metaflac) + +(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=GENRE") + "The argument to pass to `emms-info-metaflac-program-name'." + :type '(repeat string) + :group 'emms-info-metaflac) + +(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 (eq 'file (emms-track-type 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/lisp/emms-info-mp3info.el b/lisp/emms-info-mp3info.el new file mode 100644 index 0000000..b1345cd --- /dev/null +++ b/lisp/emms-info-mp3info.el @@ -0,0 +1,103 @@ +;;; emms-info-mp3info.el --- Info-method for EMMS using mp3info + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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 + :group 'emms-info-mp3info) + +(defcustom emms-info-mp3info-program-name "mp3info" + "*The name/path of the mp3info tag program." + :type 'string + :group 'emms-info-mp3info) + +(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) + :group 'emms-info-mp3info) + +(defun emms-info-mp3info (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (eq 'file (emms-track-type 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/lisp/emms-info-ogg.el b/lisp/emms-info-ogg.el new file mode 100644 index 0000000..035a8c6 --- /dev/null +++ b/lisp/emms-info-ogg.el @@ -0,0 +1,92 @@ +;;; emms-info-ogg.el --- ogg-comment.el info-interface for EMMS + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Authors: Yoni Rabkin , +;; Ulrik Jensen + +;; Keywords: ogg, emms, info + +;; 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 an interface to retrieving comments from +;; ogg-files, using Lawrence Mitchells ogg-comment.el. + +;; To activate, put something like this in your ~/.emacs: + +;; (require 'emms-info-ogg) +;; (add-to-list 'emms-info-methods-list 'emms-info-ogg) + +;; You'll of course need to also have a player if you want to actually +;; play the files. + +;;; Code: + +(require 'emms-info) +(require 'ogg-comment) + +(defvar emms-info-ogg-version "0.2 $Revision: 1.14 $" + "EMMS info ogg version string.") +;; $Id: emms-info-ogg.el,v 1.14 2005/07/09 11:56:00 forcer Exp $ + +(defgroup emms-info-ogg nil + "An EMMS-info method for getting/setting ogg-comments, using +ogg-comments.el" + :group 'emms-info-methods + :prefix "emms-info-ogg-") + +(defun emms-info-ogg-get-comment (field info) + (let ((comment (cadr (assoc field (cadr info))))) + (if comment + comment + ""))) + +(defun emms-info-ogg (track) + "Retrieve an emms-info structure as an ogg-comment" + (when (and (eq 'file (emms-track-type track)) + (string-match "\\.[Oo][Gg][Gg]\\'" (emms-track-name track))) + (let ((info (oggc-read-header (emms-track-name track))) + (file (emms-track-get track 'name)) + ptime-total ptime-min ptime-sec) + (with-temp-buffer + (call-process "ogginfo" nil t nil file) + (goto-char (point-min)) + (re-search-forward "Playback length: \\([0-9]*\\)m:\\([0-9]*\\)") + (let ((minutes (string-to-number (match-string 1))) + (seconds (string-to-number (match-string 2)))) + (setq ptime-total (+ (* minutes 60) seconds) + ptime-min minutes + ptime-sec seconds))) + + (emms-track-set track 'info-title (emms-info-ogg-get-comment "title" info)) + (emms-track-set track 'info-artist (emms-info-ogg-get-comment "artist" info)) + (emms-track-set track 'info-composer (emms-info-ogg-get-comment "composer" info)) + (emms-track-set track 'info-performer (emms-info-ogg-get-comment "performer" info)) + (emms-track-set track 'info-album (emms-info-ogg-get-comment "album" info)) + (emms-track-set track 'info-note (emms-info-ogg-get-comment "comment" info)) + (emms-track-set track 'info-year (emms-info-ogg-get-comment "date" info)) + (emms-track-set track 'info-genre (emms-info-ogg-get-comment "genre" info)) + (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))))) + +(provide 'emms-info-ogg) +;;; emms-info-ogg.el ends here diff --git a/lisp/emms-info-ogginfo.el b/lisp/emms-info-ogginfo.el new file mode 100644 index 0000000..e59b70a --- /dev/null +++ b/lisp/emms-info-ogginfo.el @@ -0,0 +1,85 @@ +;;; emms-info-ogginfo.el --- Emms information from Ogg Vorbis files. + +;; Copyright (C) 2005, 2006, 2007 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 + :group 'emms-info-ogginfo) + +(defcustom emms-info-ogginfo-program-name "ogginfo" + "*The name/path of the ogginfo tag program." + :type 'string + :group 'emms-info-ogginfo) + +(defun emms-info-ogginfo (track) + "Add track information to TRACK. +This is a useful element for `emms-info-functions'." + (when (and (eq 'file (emms-track-type 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))) + (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/lisp/emms-info.el b/lisp/emms-info.el new file mode 100644 index 0000000..d60edb9 --- /dev/null +++ b/lisp/emms-info.el @@ -0,0 +1,135 @@ +;;; emms-info.el --- Retrieving track information + +;; Copyright (C) 2005, 2006, 2007 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-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 '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 + :group 'emms-info) + +(defcustom emms-info-asynchronously t + "*Non-nil when track information should be loaded asynchronously. +This requires `later-do', which should come with EMMS." + :type 'boolean + :group 'emms-info) + +(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 + :group 'emms-info) + +(defcustom emms-info-functions nil + "*Functions which add information to tracks. +Each is called with a track as argument." + :type 'hook + :group 'emms-info) + +(defvar emms-info-asynchronous-tracks 0 + "Number of tracks we're waiting for to be done.") + +(defun emms-info-initialize-track (track) + "Initialize TRACK with emms-info information. +This is a suitable value for `emms-track-initialize-functions'." + (if (not emms-info-asynchronously) + (emms-info-really-initialize-track track) + (setq emms-info-asynchronous-tracks (1+ emms-info-asynchronous-tracks)) + (later-do 'emms-info-really-initialize-track track))) + +(defun emms-info-really-initialize-track (track) + "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)) + (name (emms-track-get track 'name))) + + ;; 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)) + (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 the current track." + (let ((artist (emms-track-get track 'info-artist)) + (title (emms-track-get track 'info-title))) + (if (and artist title) + (format "%s - %s" artist title) + (emms-track-simple-description track)))) + +(provide 'emms-info) +;;; emms-info.el ends here diff --git a/lisp/emms-last-played.el b/lisp/emms-last-played.el new file mode 100644 index 0000000..1446de6 --- /dev/null +++ b/lisp/emms-last-played.el @@ -0,0 +1,123 @@ +;;; emms-last-played.el --- Support for last-played-time of a track + +;; Copyright (C) 2006, 2007 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 (time-to-seconds messy-date)) + (now (time-to-seconds (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)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format) (seconds-to-time messy-date))) + (error "Never."))) + +(provide 'emms-last-played) +;;; emms-last-played.el ends here diff --git a/lisp/emms-lastfm.el b/lisp/emms-lastfm.el new file mode 100644 index 0000000..1f597d7 --- /dev/null +++ b/lisp/emms-lastfm.el @@ -0,0 +1,673 @@ +;;; emms-lastfm.el --- add your listened songs to your profile at last.fm + +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +;; Author: Tassilo Horn + +;; 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 sends information about what music you are playing to last.fm. +;; See and +;; . + +;;; Sample configuration: + +;; (setq emms-lastfm-username "my-user-name" +;; emms-lastfm-password "very-secret!") + +;;; Usage: + +;; To activate the last.fm emms plugin, run: +;; `M-x emms-lastfm-enable' + +;; Now all music you listen to will be submitted to Last.fm to enhance your +;; profile. + +;; To deactivate the last.fm emms plugin, run: +;; `M-x emms-lastfm-disable' + +;; Beside submitting the tracks you listen to, you can also listen to Last.fm +;; radio. Simply copy the lastfm:// URL and run & paste: +;; `M-x emms-lastfm-radio RET lastfm://artist/Britney Spears/fans' +;; (Of course you don't need to use _this_ URL. :-)) + +;; You can also insert Last.fm streams into playlists (or use +;; emms-streams.el to listen to them) by activating the player as +;; follows. +;; (add-to-list 'emms-player-list 'emms-player-lastfm-radio) +;; To insert a Last.fm stream into a playlist, do +;; (emms-insert-lastfm "lastfm://rest-of-url") + +;; There are some functions for conveniently playing the Similar Artists and +;; the Global Tag Radio. Here you only need to enter the band's name or the tag +;; respectively. +;; `M-x emms-lastfm-radio-similar-artists RET Britney Spears' +;; `M-x emms-lastfm-radio-global-tag RET pop' + +;; When you're listening to a Last.fm radio station you have the possibility to +;; give feedback to them. If you like the current song, type +;; `M-x emms-lastfm-radio-love'. +;; If it's not that good, or it just happens to not fit to your actual mood, +;; type +;; `M-x emms-lastfm-radio-skip' +;; and this song will be skipped. +;; If you really hate that song and you never want to hear it again, ban it by +;; typing +;; `M-x emms-lastfm-radio-ban'. + +;;; TODO +;; +;; - Get the last.fm radio stuff right again. Currently the rating stuff seems +;; to be broken. There seems to be no official API, so one needs to look +;; into the sources of the official client which can be found at +;; http://www.audioscrobbler.net/development/client/. + +;; ----------------------------------------------------------------------- + +(require 'url) +(require 'emms) +(require 'emms-mode-line) +(require 'emms-playing-time) +(require 'emms-source-file) +(require 'emms-url) + +;;; Variables + +(defgroup emms-lastfm nil + "Interaction with the services offered by http://www.last.fm." + :prefix "emms-lastfm-" + :group 'emms) + +(defcustom emms-lastfm-username "" + "Your last.fm username" + :type 'string + :group 'emms-lastfm) + +(defcustom emms-lastfm-password "" + "Your last.fm password" + :type 'string + :group 'emms-lastfm) + +(defcustom emms-lastfm-submission-verbose-p nil + "If non-nil, display a message every time we submit a track to Last.fm." + :type 'boolean + :group 'emms-lastfm) + +(defcustom emms-lastfm-submit-track-types '(file) + "Specify what types of tracks to submit to Last.fm. +The default is to only submit files. + +To submit every track to Last.fm, set this to t. + +Note that it is not very meaningful to submit playlists, +streamlists, or Last.fm streams to Last.fm." + :type '(choice (const :tag "All" t) + (set :tag "Types" + (const :tag "Files" file) + (const :tag "URLs" url) + (const :tag "Playlists" playlist) + (const :tag "Streamlists" streamlist) + (const :tag "Last.fm streams" lastfm))) + :group 'emms-lastfm) + +(defconst emms-lastfm-server "http://post.audioscrobbler.com/" + "The last.fm server responsible for the handshaking +procedure. Only for internal use.") +(defconst emms-lastfm-client-id "ems" + "The client ID of EMMS. Don't change it!") +(defconst emms-lastfm-client-version 0.2 + "The version registered at last.fm. Don't change it!") +(defconst emms-lastfm-protocol-version 1.2 + "The version of the supported last.fm protocol. Don't change it.") + +;; used internally +(defvar emms-lastfm-process nil "-- only used internally --") +(defvar emms-lastfm-session-id nil "-- only used internally --") +(defvar emms-lastfm-now-playing-url nil "-- only used internally --") +(defvar emms-lastfm-submit-url nil "-- only used internally --") +(defvar emms-lastfm-current-track nil "-- only used internally --") +(defvar emms-lastfm-timer nil "-- only used internally --") +(defvar emms-lastfm-current-track-starting-time-string nil "-- only used internally --") + +;;; Scrobbling + +(defun emms-lastfm-new-track-function () + "This function should run whenever a new track starts (or a +paused track resumes) and sets the track submission timer." + (setq emms-lastfm-current-track + (emms-playlist-current-selected-track)) + (setq emms-lastfm-current-track-starting-time-string + (emms-lastfm-current-unix-time-string)) + ;; Tracks should be submitted, if they played 240 secs or half of their + ;; length, whichever comes first. + (let ((secs (emms-track-get emms-lastfm-current-track 'info-playing-time)) + (type (emms-track-type emms-lastfm-current-track))) + (when (and secs + (or (eq emms-lastfm-submit-track-types t) + (and (listp emms-lastfm-submit-track-types) + (memq type emms-lastfm-submit-track-types)))) + (when (> secs 240) + (setq secs 240)) + (unless (< secs 30) ;; Skip titles shorter than 30 seconds + (setq secs (- (/ secs 2) emms-playing-time)) + (unless (< secs 0) + (setq emms-lastfm-timer + (run-with-timer secs nil 'emms-lastfm-submit-track)))))) + ;; Update the now playing info displayed on the user's last.fm page. This + ;; doesn't affect the user's profile, so it can be done even for tracks that + ;; should not be submitted. + (emms-lastfm-submit-now-playing)) + +(defun emms-lastfm-http-POST (url string sentinel &optional sentinel-args) + "Perform a HTTP POST request to URL using STRING as data. +STRING will be encoded to utf8 before the request. Call SENTINEL +with the result buffer." + (let ((url-http-attempt-keepalives nil) + (url-show-status emms-lastfm-submission-verbose-p) + (url-request-method "POST") + (url-request-extra-headers + '(("Content-type" + . "application/x-www-form-urlencoded; charset=utf-8"))) + (url-request-data (encode-coding-string string 'utf-8))) + (url-retrieve url sentinel sentinel-args))) + +(defun emms-lastfm-http-GET (url sentinel &optional sentinel-args) + "Perform a HTTP GET request to URL. +Call SENTINEL with SENTINEL-ARGS and the result buffer." + (let ((url-show-status emms-lastfm-submission-verbose-p) + (url-request-method "GET")) + (url-retrieve url sentinel sentinel-args))) + +(defun emms-lastfm-submit-now-playing () + "Submit now-playing infos to last.fm. +These will be displayed on the user's last.fm page." + (let* ((artist (emms-track-get emms-lastfm-current-track 'info-artist)) + (title (emms-track-get emms-lastfm-current-track 'info-title)) + (album (emms-track-get emms-lastfm-current-track 'info-album)) + (track-number (emms-track-get emms-lastfm-current-track + 'info-tracknumber)) + (musicbrainz-id "") + (track-length (number-to-string + (or (emms-track-get emms-lastfm-current-track + 'info-playing-time) + 0)))) + ;; wait up to 5 seconds to submit np infos in order to finish handshaking. + (dotimes (i 5) + (when (not (and emms-lastfm-session-id + emms-lastfm-now-playing-url)) + (sit-for 1))) + (when (and emms-lastfm-session-id + emms-lastfm-now-playing-url) + (emms-lastfm-http-POST emms-lastfm-now-playing-url + (concat "&s=" emms-lastfm-session-id + "&a[0]=" (emms-url-quote artist) + "&t[0]=" (emms-url-quote title) + "&b[0]=" (emms-url-quote album) + "&l[0]=" track-length + "&n[0]=" track-number + "&m[0]=" musicbrainz-id) + 'emms-lastfm-submit-now-playing-sentinel)))) + +(defun emms-lastfm-submit-now-playing-sentinel (&rest args) + "Parses the server reponse and inform the user if all worked +well or if an error occured." + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (goto-char (point-min)) + ;; skip to the first empty line and go one line further. There the last.fm + ;; response starts. + (re-search-forward "^$" nil t) + (forward-line) + (if (re-search-forward "^OK$" nil t) + (progn + (when emms-lastfm-submission-verbose-p + (message "EMMS: Now playing infos submitted to last.fm")) + (kill-buffer buffer)) + (message "EMMS: Now playing infos couldn't be submitted to last.fm: %s" + (emms-read-line))))) + +(defun emms-lastfm-cancel-timer () + "Cancels `emms-lastfm-timer' if it is running." + (emms-cancel-timer emms-lastfm-timer) + (setq emms-lastfm-timer nil)) + +(defun emms-lastfm-pause () + "Handles things to be done when the player is paused or +resumed." + (if emms-player-paused-p + ;; the player paused + (emms-lastfm-cancel-timer) + ;; The player resumed + (emms-lastfm-new-track-function))) + +(defun emms-lastfm (&optional ARG) + "Start submitting the tracks you listened to to +http://www.last.fm, if ARG is positive. If ARG is negative or +zero submission of the tracks will be stopped. This applies to +the current track, too." + (interactive "p") + (cond + ((not (and emms-lastfm-username emms-lastfm-password)) + (message "%s" + (concat "EMMS: In order to activate the last.fm plugin you " + "first have to set both `emms-lastfm-username' and " + "`emms-lastfm-password'"))) + ((not emms-playing-time-p) + (message "%s" + (concat "EMMS: The last.fm plugin needs the functionality " + "provided by `emms-playing-time'. It seems that you " + "disabled it explicitly in your init file using code " + "like this: `(emms-playing-time -1)'. Delete that " + "line and have a look at `emms-playing-time's doc " + "string"))) + (t + (if (and ARG (> ARG 0)) + (progn + ;; Append it. Else the playing time could be started a bit too late. + (add-hook 'emms-player-started-hook + 'emms-lastfm-handshake-if-needed t) + ;; Has to be appended, because it has to run after + ;; `emms-playing-time-start' + (add-hook 'emms-player-started-hook + 'emms-lastfm-new-track-function t) + (add-hook 'emms-player-stopped-hook + 'emms-lastfm-cancel-timer) + (add-hook 'emms-player-paused-hook + 'emms-lastfm-pause) + (message "EMMS Last.fm plugin activated")) + (remove-hook 'emms-player-started-hook + 'emms-lastfm-handshake-if-needed) + (remove-hook 'emms-player-started-hook + 'emms-lastfm-new-track-function) + (remove-hook 'emms-player-stopped-hook + 'emms-lastfm-cancel-timer) + (remove-hook 'emms-player-paused-hook + 'emms-lastfm-pause) + (when emms-lastfm-timer (emms-cancel-timer emms-lastfm-timer)) + (setq emms-lastfm-session-id nil + emms-lastfm-submit-url nil + emms-lastfm-process nil + emms-lastfm-current-track nil) + (message "EMMS Last.fm plugin deactivated"))))) + +(defalias 'emms-lastfm-activate 'emms-lastfm) +(emms-make-obsolete 'emms-lastfm-activate 'emms-lastfm "EMMS 2.2") + +(defun emms-lastfm-enable () + "Enable the emms last.fm plugin." + (interactive) + (emms-lastfm 1)) + +(defun emms-lastfm-disable () + "Disable the emms last.fm plugin." + (interactive) + (emms-lastfm -1)) + +(defun emms-lastfm-restart () + "Disable and reenable the last.fm plugin. This will cause a new +handshake." + (emms-lastfm-disable) + (emms-lastfm-enable)) + +(defun emms-lastfm-handshake-if-needed () + (when (not (and emms-lastfm-session-id + emms-lastfm-submit-url + emms-lastfm-now-playing-url)) + (emms-lastfm-handshake))) + +(defun emms-lastfm-current-unix-time-string () + (replace-regexp-in-string "\\..*" "" (number-to-string (float-time)))) + +(defun emms-lastfm-handshake () + "Handshakes with the last.fm server." + (let ((timestamp (emms-lastfm-current-unix-time-string))) + (emms-lastfm-http-GET + (concat emms-lastfm-server + "?hs=true" + "&p=" (number-to-string emms-lastfm-protocol-version) + "&c=" emms-lastfm-client-id + "&v=" (number-to-string emms-lastfm-client-version) + "&u=" (emms-url-quote emms-lastfm-username) + "&t=" timestamp + "&a=" (md5 (concat (md5 emms-lastfm-password) timestamp))) + 'emms-lastfm-handshake-sentinel))) + +(defun emms-lastfm-handshake-sentinel (&rest args) + "Parses the server reponse and inform the user if all worked +well or if an error occured." + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (goto-char (point-min)) + ;; skip to the first empty line and go one line further. There the last.fm + ;; response starts. + (re-search-forward "^$" nil t) + (forward-line) + (let ((response (emms-read-line))) + (if (not (string-match (rx (or "OK")) response)) + (message "EMMS: Handshake failed: %s" response) + (forward-line) + (setq emms-lastfm-session-id (emms-read-line)) + (forward-line) + (setq emms-lastfm-now-playing-url (emms-read-line)) + (forward-line) + (setq emms-lastfm-submit-url (emms-read-line)) + (message "EMMS: Handshaking with server done") + (kill-buffer buffer))))) + +(defun emms-lastfm-submit-track () + "Submits the current track (`emms-lastfm-current-track') to +last.fm." + (let* ((artist (emms-track-get emms-lastfm-current-track 'info-artist)) + (title (emms-track-get emms-lastfm-current-track 'info-title)) + (album (emms-track-get emms-lastfm-current-track 'info-album)) + (track-number (emms-track-get emms-lastfm-current-track 'info-tracknumber)) + (musicbrainz-id "") + (track-length (number-to-string + (emms-track-get emms-lastfm-current-track + 'info-playing-time)))) + (emms-lastfm-http-POST + emms-lastfm-submit-url + (concat "&s=" emms-lastfm-session-id + "&a[0]=" (emms-url-quote artist) + "&t[0]=" (emms-url-quote title) + "&i[0]=" emms-lastfm-current-track-starting-time-string + "&o[0]=P" ;; TODO: Maybe support others. See the API. + "&r[0]=" ;; The rating. Empty if not applicable (for P it's not) + "&l[0]=" track-length + "&b[0]=" (emms-url-quote album) + "&n[0]=" track-number + "&m[0]=" musicbrainz-id) + 'emms-lastfm-submission-sentinel))) + +(defun emms-lastfm-submission-sentinel (&rest args) + "Parses the server reponse and inform the user if all worked +well or if an error occured." + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (goto-char (point-min)) + ;; skip to the first empty line and go one line further. There the last.fm + ;; response starts. + (re-search-forward "^$" nil t) + (forward-line) + (if (re-search-forward "^OK$" nil t) + (progn + (when emms-lastfm-submission-verbose-p + (message "EMMS: \"%s\" submitted to last.fm" + (emms-track-description emms-lastfm-current-track))) + (kill-buffer buffer)) + (message "EMMS: Song couldn't be submitted to last.fm: %s" + (emms-read-line))))) + +;;; Playback of lastfm:// streams + +(defgroup emms-player-lastfm-radio nil + "EMMS player for Last.fm streams." + :group 'emms-player + :prefix "emms-player-lastfm-") + +(defcustom emms-player-lastfm-radio (emms-player 'emms-lastfm-radio-start + 'ignore ; no need to stop + 'emms-lastfm-radio-playable-p) + "*Parameters for the Last.fm radio player." + :type '(cons symbol alist) + :group 'emms-player-lastfm-radio) + +(defconst emms-lastfm-radio-base-url "http://ws.audioscrobbler.com/radio/" + "The base URL for playing lastfm:// stream. +-- only used internally --") + +(defvar emms-lastfm-radio-session nil "-- only used internally --") +(defvar emms-lastfm-radio-stream-url nil "-- only used internally --") + +(defun emms-lastfm-radio-get-handshake-url () + (concat emms-lastfm-radio-base-url + "handshake.php?version=" (number-to-string + emms-lastfm-client-version) + "&platform=" emms-lastfm-client-id + "&username=" (emms-url-quote emms-lastfm-username) + "&passwordmd5=" (md5 emms-lastfm-password) + "&debug=" (number-to-string 9))) + +(defun emms-lastfm-radio-handshake (fn radio-url) + "Handshakes with the last.fm server. +Calls FN when done with RADIO-URL as its only argument." + (emms-lastfm-http-GET (emms-lastfm-radio-get-handshake-url) + 'emms-lastfm-radio-handshake-sentinel + (list fn radio-url))) + +(defun emms-lastfm-radio-handshake-sentinel (status fn radio-url) + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (setq emms-lastfm-radio-session (emms-key-value "session")) + (setq emms-lastfm-radio-stream-url (emms-key-value "stream_url")) + (kill-buffer buffer) + (if (and emms-lastfm-radio-session emms-lastfm-radio-stream-url) + (progn + (message "EMMS: Handshaking for Last.fm playback successful") + (funcall fn radio-url)) + (message "EMMS: Failed handshaking for Last.fm playback")))) + +(defun emms-lastfm-radio-1 (lastfm-url) + "Internal function used by `emms-lastfm-radio'." + (if (and emms-lastfm-radio-session + emms-lastfm-radio-stream-url) + (progn + (emms-lastfm-http-GET + (concat emms-lastfm-radio-base-url + "adjust.php?" + "session=" emms-lastfm-radio-session + "&url=" (emms-url-quote lastfm-url) + "&debug=" (number-to-string 0)) + 'emms-lastfm-radio-sentinel)) + (message "EMMS: Cannot play Last.fm stream"))) + +(defun emms-lastfm-radio (lastfm-url) + "Plays the stream associated with the given Last.fm URL. (A +Last.fm URL has the form lastfm://foo/bar/baz, e.g. + + lastfm://artist/Manowar/similarartists + +or + + lastfm://globaltags/metal." + (interactive "sLast.fm URL: ") + ;; Streamed songs must not be added to the lastfm profile + (emms-lastfm-disable) + (if (not (and emms-lastfm-radio-session + emms-lastfm-radio-stream-url)) + (emms-lastfm-radio-handshake #'emms-lastfm-radio-1 lastfm-url) + (emms-lastfm-radio-1 lastfm-url))) + +(defun emms-lastfm-radio-playable-p (track) + "Determine whether the Last.fm player can play this track." + (let ((name (emms-track-get track 'name)) + (type (emms-track-get track 'type))) + (and (eq type 'lastfm) + (string-match "^lastfm://" name)))) + +(defun emms-lastfm-radio-start (track) + "Start playing TRACK." + (when (emms-lastfm-radio-playable-p track) + (let ((name (emms-track-get track 'name))) + (emms-lastfm-radio name)))) + +(defcustom emms-lastfm-radio-metadata-period 15 + "When listening to Last.fm Radio every how many seconds should +emms-lastfm poll for metadata? If set to nil, there won't be any +polling at all. + +The default is 15: That means that the mode line will display the +wrong (last) track's data for a maximum of 15 seconds. If your +network connection has a big latency this value may be too +high. (But then streaming a 128KHz mp3 won't be fun anyway.)" + :type '(choice integer + (const :tag "Disable" nil)) + :group 'emms-lastfm) + +(defun emms-lastfm-radio-sentinel (&rest args) + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (if (string= (emms-key-value "response" buffer) "OK") + (progn + (kill-buffer buffer) + (emms-play-url emms-lastfm-radio-stream-url) + (when emms-lastfm-radio-metadata-period + (setq emms-lastfm-timer + (run-with-timer 0 emms-lastfm-radio-metadata-period + 'emms-lastfm-radio-request-metadata)) + (add-hook 'emms-player-stopped-hook + 'emms-lastfm-cancel-timer)) + (message "EMMS: Playing Last.fm stream")) + (kill-buffer buffer) + (message "EMMS: Bad response from Last.fm")))) + +(defun emms-lastfm-np (&optional insertp callback) + "Show the currently-playing lastfm radio tune. + +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." + (interactive "P") + (emms-lastfm-radio-request-metadata + (lambda (status insertp buffer callback) + (let ((response-buf (current-buffer)) + artist title) + (emms-http-decode-buffer response-buf) + (setq artist (emms-key-value "artist" response-buf) + title (emms-key-value "track" response-buf)) + (kill-buffer response-buf) + (let ((msg (if (and title artist) + (format emms-show-format + (format "%s - %s" artist title)) + "Nothing playing right now"))) + (cond ((functionp callback) + (when (and title artist) + (funcall callback buffer msg))) + ((and insertp title artist) + (with-current-buffer buffer + (insert msg))) + (t (message msg)))))) + (list insertp (current-buffer) callback))) + +(defun emms-lastfm-radio-similar-artists (artist) + "Plays the similar artist radio of ARTIST." + (interactive "sArtist: ") + (emms-lastfm-radio (concat "lastfm://artist/" + artist + "/similarartists"))) + +(defun emms-lastfm-radio-global-tag (tag) + "Plays the global tag radio of TAG." + (interactive "sGlobal Tag: ") + (emms-lastfm-radio (concat "lastfm://globaltags/" tag))) + +(defun emms-lastfm-radio-artist-fan (artist) + "Plays the artist fan radio of ARTIST." + (interactive "sArtist: ") + (emms-lastfm-radio (concat "lastfm://artist/" artist "/fans"))) + +(defun emms-lastfm-radio-love () + "Inform Last.fm that you love the currently playing song." + (interactive) + (emms-lastfm-radio-rating "love")) + +(defun emms-lastfm-radio-skip () + "Inform Last.fm that you want to skip the currently playing +song." + (interactive) + (emms-lastfm-radio-rating "skip")) + +(defun emms-lastfm-radio-ban () + "Inform Last.fm that you want to ban the currently playing +song." + (interactive) + (emms-lastfm-radio-rating "ban")) + +(defun emms-lastfm-radio-rating (command) + (emms-lastfm-http-GET + (concat emms-lastfm-radio-base-url + "control.php?" + "session=" emms-lastfm-radio-session + "&command=" command + "&debug=" (number-to-string 0)) + 'emms-lastfm-radio-rating-sentinel)) + +(defun emms-lastfm-radio-rating-sentinel (&rest args) + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (if (string= (emms-key-value "response" buffer) "OK") + (message "EMMS: Rated current track") + (message "EMMS: Rating failed")) + (kill-buffer buffer))) + +(defun emms-lastfm-radio-request-metadata (&optional fn data) + "Request the metadata of the current song and display it. + +If FN is given, call it instead of +`emms-lastfm-radio-request-metadata-sentinel', with DATA as its +first parameter. + +If DATA is given, it should be a list." + (interactive) + (emms-lastfm-http-GET + (concat emms-lastfm-radio-base-url + "np.php?" + "session=" emms-lastfm-radio-session + "&debug=" (number-to-string 0)) + (or fn 'emms-lastfm-radio-request-metadata-sentinel) + data)) + +(defun emms-lastfm-radio-request-metadata-sentinel (&rest args) + (let ((buffer (current-buffer))) + (emms-http-decode-buffer buffer) + (let ((artist (emms-key-value "artist" buffer)) + (title (emms-key-value "track" buffer)) + (track (emms-playlist-current-selected-track))) + (kill-buffer buffer) + (emms-track-set track 'info-artist artist) + (emms-track-set track 'info-title title) + (emms-track-updated track)))) + + +;;; Utility functions + +(defun emms-read-line () + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))) + +(defun emms-key-value (key &optional buffer) + "Returns the value of KEY from BUFFER. +If BUFFER is nil, use the current buffer. + +BUFFER has to contain a key-value list like: + +foo=bar +x=17" + (unless (and buffer (not (buffer-live-p buffer))) + (with-current-buffer (or buffer (current-buffer)) + (goto-char (point-min)) + (when (re-search-forward (concat "^" key "=") nil t) + (buffer-substring-no-properties (point) (line-end-position)))))) + +(provide 'emms-lastfm) +;;; emms-lastfm.el ends here diff --git a/lisp/emms-lyrics.el b/lisp/emms-lyrics.el new file mode 100644 index 0000000..dfcc7a8 --- /dev/null +++ b/lisp/emms-lyrics.el @@ -0,0 +1,520 @@ +;;; emms-lyrics.el --- Display lyrics synchronically + +;; Copyright (C) 2005, 2006, 2007, 2008 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) + +;;; 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 + :group 'emms-lyrics) + +(defcustom emms-lyrics-display-on-minibuffer nil + "If non-nil, display lyrics on minibuffer." + :type 'boolean + :group 'emms-lyrics) + +(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 + :group 'emms-lyrics) + +(defcustom emms-lyrics-display-format " %s " + "Format for displaying lyrics." + :type 'string + :group 'emms-lyrics) + +(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 + :group 'emms-lyrics) + +(defcustom emms-lyrics-mode-hook nil + "Normal hook run after entering Emms Lyric mode." + :type 'hook + :group 'emms-lyrics) + +(defcustom emms-lyrics-find-lyric-function 'emms-lyrics-find-lyric + "Function for finding lyric files." + :type 'symbol + :group 'emms-lyrics) + +(defcustom emms-lyrics-scroll-p t + "Non-nil value will enable lyrics scrolling." + :type 'boolean + :group 'emms-lyrics) + +(defcustom emms-lyrics-scroll-timer-interval 0.4 + "Interval between scroller timers. The shorter, the faster." + :type 'number + :group 'emms-lyrics) + + +;;; User Interfaces + +(defvar emms-lyrics-display-p t + "If non-nil, will diplay lyrics.") + +(defvar emms-lyrics-mode-line-string "" + "Current lyric.") + +;;;###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 (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, search it from internet...") + (let ((title (emms-track-get track 'title)) + (filename (file-name-sans-extension + (file-name-nondirectory name))) + (url "")) + (unless title + (setq title filename)) + (cond ((string-match "\\cc" title) ; chinese lyrics + ;; Since tag info might be encoded using various coding + ;; systems, we'd better fall back on filename. + (setq url (format + "http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word=%s&lm=-1" + (emms-url-quote-plus + (encode-coding-string filename 'gb2312))))) + (t ; english lyrics + (setq url (format "http://search.lyrics.astraweb.com/?word=%s" + ;;"http://www.lyrics007.com/cgi-bin/s.cgi?q=" + (emms-url-quote-plus title))))) + (browse-url url) + (message "lyric file does not exist, search it from internet...done"))))) + + +;;; 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)) + (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-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)))) + (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 + (time-to-seconds (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 + (+ (time-to-seconds + (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 + (time-to-seconds (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)) + (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 emms-lyrics-timers + (append emms-lyrics-timers + (list + (run-at-time (format "%d sec" time) + nil + 'emms-lyrics-display-handler + lyric + next-lyric + (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 diff) + "DIFF is the timestamp differences between current LYRIC and +NEXT-LYRIC." + (emms-lyrics-display (format emms-lyrics-display-format lyric)) + (when emms-lyrics-scroll-p + (emms-lyrics-scroll lyric next-lyric diff))) + +(defun emms-lyrics-display (lyric) + "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))))) + +(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)))))) + (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 (+ (time-to-seconds + (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/lisp/emms-maint.el b/lisp/emms-maint.el new file mode 100644 index 0000000..f68f6bd --- /dev/null +++ b/lisp/emms-maint.el @@ -0,0 +1 @@ +(add-to-list 'load-path ".") diff --git a/lisp/emms-mark.el b/lisp/emms-mark.el new file mode 100644 index 0000000..d989078 --- /dev/null +++ b/lisp/emms-mark.el @@ -0,0 +1,296 @@ +;;; emms-mark.el --- mark track like dired + +;; Copyright (C) 2006, 2007 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 'emms) +(require 'emms-playlist-mode) +(eval-when-compile + (require 'cl)) + +;;{{{ set new description-function +(defun emms-mark-track-description (track) + "Return a description of the current track." + (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 + "Mark tracks matching: " + "Unmark 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 +(defconst 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 () + "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 + (setq emms-playlist-buffer-p t) + (unless (eq major-mode 'emms-playlist-mode) + (emms-playlist-mode)) + + ;; 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/lisp/emms-metaplaylist-mode.el b/lisp/emms-metaplaylist-mode.el new file mode 100644 index 0000000..4b59421 --- /dev/null +++ b/lisp/emms-metaplaylist-mode.el @@ -0,0 +1,184 @@ +;;; emms-metaplaylist-mode.el --- A major mode for lists of Emms +;;; playlists + +;; Copyright (C) 2006, 2007 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 Playlists*" + "*Name of the buffer in which Emms playlists will be listed." + :type 'string + :group 'emms-metaplaylist-mode) + +(defcustom emms-metaplaylist-mode-hooks nil + "*List of hooks to run on entry to emms-metaplaylist-mode." + :type 'list + :group 'emms-metaplaylist-mode) + +(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." + :group 'emms-metaplaylist-mode) + +(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." + :group 'emms-metaplaylist-mode) + +;;; -------------------------------------------------------- +;;; Keymap +;;; -------------------------------------------------------- + +(defconst 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 "q") 'kill-this-buffer) + (define-key map (kbd "?") 'describe-mode) + (define-key map (kbd "SPC") 'emms-metaplaylist-set-active) + (define-key map (kbd "c") 'emms-metaplaylist-new-buffer) + map) + "Keymap for `emms-metaplaylist-mode'.") + +;;; -------------------------------------------------------- +;;; Metaplaylist +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-mode-goto-current () + "Switch to the buffer at point." + (interactive) + (switch-to-buffer + (buffer-substring (point-at-bol) + (point-at-eol)))) + +;; Since there will never be a significantly large amount of playlist +;; buffers co-existing at once, we allow ourselves not to keep +;; state. We regenerate the playlists buffer anew on demand. +(defun emms-metaplaylist-mode-create () + "Create or recreate the meta-playlist buffer." + (let ((name emms-metaplaylist-mode-buffer-name) + (playlists (emms-playlist-buffer-list))) + (if playlists + (progn + (condition-case nil + (kill-buffer name) + (error nil)) + (get-buffer-create name) + (with-current-buffer name + (emms-metaplaylist-mode) + (save-excursion + (mapc (lambda (buf) + (let ((inhibit-read-only t)) + (insert (buffer-name buf)) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'face + (if (eq buf emms-playlist-buffer) + 'emms-metaplaylist-mode-current-face + 'emms-metaplaylist-mode-face))) + (newline))) + playlists)) + (current-buffer))) ; return the buffer as lisp obj + (error "No Emms playlist buffers")))) + +;;; -------------------------------------------------------- +;;; Playlist Management : creation, deletion (?) +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-new-buffer (buffer-name) + "Creates a new buffer called buffer-name, which will be ready +to host EMMS tracks." + (interactive "sBuffer Name: ") + (if(get-buffer buffer-name) + (error "Buffer must not exist.") + (let ((buf (get-buffer-create buffer-name))) + (with-current-buffer buf + (setq emms-playlist-buffer-p t))) + (message "Buffer created"))) + +(defun emms-metaplaylist-set-active () + (interactive) + (emms-playlist-set-playlist-buffer + (get-buffer (buffer-substring (point-at-bol) (point-at-eol)))) + (let ((ici (point))) + (emms-metaplaylist-mode-go) + (goto-char ici))) + +;;; -------------------------------------------------------- +;;; Mode entry +;;; -------------------------------------------------------- + +(defun emms-metaplaylist-mode-go () + "Single entry point to the metaplaylist interface." + (interactive) + (emms-metaplaylist-mode-create) + (switch-to-buffer emms-metaplaylist-mode-buffer-name)) + +(defun emms-metaplaylist-mode () + "A major mode for Emms playlists." +;; (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/lisp/emms-mode-line-icon.el b/lisp/emms-mode-line-icon.el new file mode 100644 index 0000000..b6822f2 --- /dev/null +++ b/lisp/emms-mode-line-icon.el @@ -0,0 +1,79 @@ +;; emms-mode-line-icon.el --- show an icon in the Emacs mode-line + +;; Copyright (C) 2006, 2007 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-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 ]\"") + +(defvar emms-mode-line-icon-image-cache + `(image :type xpm :ascent center :data ,(concat "/* XPM */ +static char *note[] = { +/* width height num_colors chars_per_pixel */ +\" 10 11 2 1\", +/* colors */ +\". c " emms-mode-line-icon-color "\", +\"# c None s None\", +/* pixels */ +\"###...####\", +\"###.#...##\", +\"###.###...\", +\"###.#####.\", +\"###.#####.\", +\"#...#####.\", +\"....#####.\", +\"#..######.\", +\"#######...\", +\"######....\", +\"#######..#\"};"))) + + +(defun emms-mode-line-icon-function () + (concat " " + emms-mode-line-icon-before-format + (emms-propertize "NP:" 'display emms-mode-line-icon-image-cache) + (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/lisp/emms-mode-line.el b/lisp/emms-mode-line.el new file mode 100644 index 0000000..f8cfec4 --- /dev/null +++ b/lisp/emms-mode-line.el @@ -0,0 +1,157 @@ +;;; emms-mode-line.el --- Mode-Line and titlebar infos for emms + +;; Copyright (C) 2004, 2005, 2006, 2007 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) + :group 'emms-mode-line) + +(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) + :group 'emms-mode-line) + +(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)))) + +(defvar emms-mode-line-active-p nil + "If non-nil, emms mode line is active.") +(defvar emms-mode-line-string "") + +(defvar emms-mode-line-initial-titlebar frame-title-format) + +(defun emms-mode-line (arg) + "Turn on `emms-mode-line' if ARG is positive, off otherwise." + (interactive "p") + (or global-mode-string (setq global-mode-string '(""))) + (if (and arg (> arg 0)) + (progn + (setq emms-mode-line-active-p t) + (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))) + (setq emms-mode-line-active-p nil) + (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'." + (interactive) + (emms-mode-line 1) + (message "emms mode line enabled")) + +;;;###autoload +(defun emms-mode-line-disable () + "Turn off `emms-mode-line'." + (interactive) + (emms-mode-line -1) + (message "emms mode line disabled")) + +;;;###autoload +(defun emms-mode-line-toggle () + "Toggle `emms-mode-line'." + (interactive) + (if emms-mode-line-active-p + (emms-mode-line-disable) + (emms-mode-line-enable))) + +(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." + (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/lisp/emms-player-mpd.el b/lisp/emms-player-mpd.el new file mode 100644 index 0000000..ba31df4 --- /dev/null +++ b/lisp/emms-player-mpd.el @@ -0,0 +1,1198 @@ +;;; emms-player-mpd.el --- MusicPD support for EMMS + +;; Copyright (C) 2005, 2006, 2007 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 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 'emms-player-simple) +(require 'emms-source-playlist) ; for emms-source-file-parse-playlist +(require 'tq) + +(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) + :group 'emms-player-mpd) + +(defcustom emms-player-mpd-music-directory nil + "The value of 'music_directory' in your MusicPD configuration file. + +You need this if your playlists use absolute file names, otherwise +leave it set to nil." + ;; 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) + :group 'emms-player-mpd) + +(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 (split-string (shell-command-to-string "mpd --version") + "\n")) + (found-start nil) + (supported nil)) + ;; Get supported formats + (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://\\|" + "\\.\\(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))) + :group 'emms-player-mpd) + +(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 + :group 'emms-player-mpd) + +(defcustom emms-player-mpd-server-name (or (getenv "MPD_HOST") "localhost") + "The MusicPD server that we should connect to." + :type 'string + :group 'emms-player-mpd) + +(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) + :group 'emms-player-mpd) + +(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) + :group 'emms-player-mpd) + +(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 or a floating point number. + +This is used only if `emms-player-mpd-sync-playlist' is non-nil" + :type 'number + :group 'emms-player-mpd) + +(defcustom emms-player-mpd-verbose nil + "Whether to provide notifications for server connection events +and errors." + :type 'boolean + :group 'emms-player-mpd) + +(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 + :group 'emms-player-mpd) + +(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-song 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)))))) + +;; Ignore a useless byte-compile warning +(eval-when-compile + (put 'process-kill-without-query 'byte-compile nil)) + +(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 + (funcall emms-player-mpd-connect-function "mpd" + nil + emms-player-mpd-server-name + emms-player-mpd-server-port)) + (set-process-sentinel emms-player-mpd-process + 'emms-player-mpd-sentinel) + (setq emms-player-mpd-queue + (tq-create emms-player-mpd-process)) + (if (fboundp 'set-process-query-on-exit-flag) + (set-process-query-on-exit-flag emms-player-mpd-process nil) + (process-kill-without-query emms-player-mpd-process)) + ;; 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 (assoc (car cell) alist) + (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) + (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) 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) 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) id))) + (emms-player-mpd-get-status-part closure callback "song" 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) 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) + (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) + "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." + (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)))) + (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 + (unless (emms-playlist-selected-track-at-p) + (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-1 (closure info) + (let ((song (emms-player-mpd-get-current-song nil #'ignore info)) + (status (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= status "stop") + (emms-player-mpd-disconnect t) + (if song + ;; a track remains: the user probably stopped MusicPD + ;; manually, so we'll stop EMMS completely + (let ((emms-player-stopped-p t)) + (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 + (emms-player-stopped))) + ((string= status "pause") + nil) + ((string= status "play") + (unless (or (null song) + (and (stringp emms-player-mpd-current-song) + (string= song emms-player-mpd-current-song))) + (let ((emms-player-stopped-p t)) + (emms-player-stopped)) + (emms-player-mpd-select-song emms-player-mpd-current-song song) + (setq emms-player-mpd-current-song song) + (emms-player-started 'emms-player-mpd) + (when time + (run-hook-with-args 'emms-player-time-set-functions + time)))))))) + +(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)) + (emms-player-mpd-send "clear" nil #'ignore)) + +;;; 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 + (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)) + ((eq type 'file) + (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." + (if id + (progn + (unless (stringp id) + (setq id (number-to-string id))) + (emms-player-mpd-send + (concat "play " id) + nil + (lambda (closure response) + (setq emms-player-mpd-current-song nil) + (setq emms-player-mpd-status-timer + (run-at-time t emms-player-mpd-check-interval + '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) + (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) + (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) + (emms-player-mpd-get-playlist-id + nil + #'emms-player-mpd-start-and-sync-1)))) + +(defun emms-player-mpd-connect-1 (closure info) + (setq emms-player-mpd-current-song 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) + (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) + (setq emms-player-mpd-current-song 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 (+ 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 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) + (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 "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 (eq 'file (emms-track-type track)) + (not (string-match "\\`http://" file))) + (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-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) + (message "Dumping MusicPD data to cache...processing") + (let ((info (emms-player-mpd-get-alists + (emms-player-mpd-parse-response response)))) + (dolist (track-info info) + (emms-cache-set-from-mpd-track track-info)) + (message "Dumping MusicPD data to cache...done"))))) + (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) + (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 "")) + +(provide 'emms-player-mpd) + +;;; emms-player-mpd.el ends here diff --git a/lisp/emms-player-mpg321-remote.el b/lisp/emms-player-mpg321-remote.el new file mode 100644 index 0000000..6022093 --- /dev/null +++ b/lisp/emms-player-mpg321-remote.el @@ -0,0 +1,222 @@ +;;; emms-player-mpg321-remote.el --- play files with mpg321 -R + +;; Copyright (C) 2006, 2007 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 + :group 'emms-player-mpg321-remote) + +(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) + :group 'emms-player-mpg321-remote) + +(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) + :group 'emms-player-mpg321-remote) + +(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" + (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) + (let* ((data-lines (split-string str "\n" t)) + data line cmd) + (dolist (line data-lines) + (setq data (split-string line)) + (setq cmd (car data)) + (cond + ;; stop notice + ((and (string= cmd "@P") + (string= (cadr data) "0")) + (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)) + +(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/lisp/emms-player-mplayer.el b/lisp/emms-player-mplayer.el new file mode 100644 index 0000000..c8bf466 --- /dev/null +++ b/lisp/emms-player-mplayer.el @@ -0,0 +1,83 @@ +;;; emms-player-mplayer.el --- mplayer support for EMMS + +;; Copyright (C) 2005, 2006, 2007, 2008 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) + (mapconcat 'regexp-quote + '(".ogg" ".mp3" ".wav" ".mpg" ".mpeg" ".wmv" ".wma" + ".mov" ".avi" ".divx" ".ogm" ".asf" ".mkv" "http://" "mms://" + ".rm" ".rmvb" ".mp4" ".flac" ".vob" ".m4a" ".ape") + "\\|") + "mplayer" "-slave" "-quiet" "-really-quiet") + +(define-emms-simple-player mplayer-playlist '(streamlist) + "http://" + "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/lisp/emms-player-simple.el b/lisp/emms-player-simple.el new file mode 100644 index 0000000..6286504 --- /dev/null +++ b/lisp/emms-player-simple.el @@ -0,0 +1,212 @@ +;;; emms-player-simple.el --- A generic simple player. + +;; Copyright (C) 2003, 2004, 2006, 2007 Free Software Foundation, Inc. + +;; Authors: Ulrik Jensen +;; Jorgen Schäfer +;; Keywords: emms, mpg321, ogg123, mplayer + +;; 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 +;; emms-player-mplayer + +;;; 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 arguement +to call the player and ARGS are the command line arguements." + (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 + :group ',group) + (defcustom ,parameters ',args + ,(concat "*The arguments to `" (symbol-name command-name) "'.") + :type '(repeat string) + :group ',group) + (defcustom ,player-name (emms-player ',start ',stop ',playablep) + ,(concat "*A player for EMMS.") + :type '(cons symbol alist) + :group ',group) + (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" + (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 gstreamer '(file) + (emms-player-simple-regexp "mp3" "ogg" "mod" "flac" "xm" "it" "ft") + "gst-wrapper" "alsasink") +(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) + (emms-player-simple-regexp ".ogg" ".mp3" ".wav" ".flac" ".pls" ".m3u" "http://") + "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/lisp/emms-player-xine.el b/lisp/emms-player-xine.el new file mode 100644 index 0000000..715dec9 --- /dev/null +++ b/lisp/emms-player-xine.el @@ -0,0 +1,92 @@ +;;; emms-player-xine.el --- xine support for EMMS + +;; Copyright (C) 2007 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) + (mapconcat 'regexp-quote + '(".ogg" ".mp3" ".wav" ".mpg" ".mpeg" ".wmv" ".wma" + ".mov" ".avi" ".divx" ".ogm" ".asf" ".mkv" "http://" "mms://" + ".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/lisp/emms-playing-time.el b/lisp/emms-playing-time.el new file mode 100644 index 0000000..18da082 --- /dev/null +++ b/lisp/emms-playing-time.el @@ -0,0 +1,226 @@ +;;; emms-playing-time.el --- Display emms playing time on mode line + +;; Copyright (C) 2005, 2006, 2007 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. + +;;; 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: + +(eval-when-compile (require 'cl)) +(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 + :group 'emms-playing-time) + +(defcustom emms-playing-time-display-format " %s " + "Format used for displaying playing time." + :type 'string + :group 'emms-playing-time) + +(defcustom emms-playing-time-style 'time + "Style used for displaying playing time. +Valid styles are `time' (e.g., 01:30/4:20) and `bar' (e.g., [===> ])." + :type 'symbol + :group 'emms-playing-time) + + +;;; Emms Playing Time + +(defvar emms-playing-time-display-p nil + "Whether to display playing time on mode line or not") + +(defvar emms-playing-time 0 + "Time elapsed in current track.") + +(defvar emms-playing-time-string "") + +(defvar emms-playing-time-display-timer nil) + +(defvar emms-playing-time-p nil + "Whether emms-playing-time module is enabled or not") + +(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) + "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'." + (if (and arg (> arg 0)) + (progn + (setq emms-playing-time-p t + emms-playing-time-display-p 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-p nil + emms-playing-time-display-p 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 +(defun emms-playing-time-enable-display () + "Display playing time on mode line." + (interactive) + (setq emms-playing-time-display-p t)) + +;;;###autoload +(defun emms-playing-time-disable-display () + "Remove playing time from mode line." + (interactive) + (setq emms-playing-time-display-p nil)) + +(defun emms-playing-time-display () + "Display playing time on the mode line." + (setq emms-playing-time (1+ emms-playing-time)) + (setq emms-playing-time-string "") + (when emms-playing-time-display-p + (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))) + (case emms-playing-time-style + ((bar) ; `bar' style + (if (zerop total-playing-time) + (setq emms-playing-time-string "[==>........]") + (let ((progress "[") + ;; percent based on 10 + (percent (/ (* emms-playing-time 10) total-playing-time))) + (dotimes (i percent) + (setq progress (concat progress "="))) + (setq progress (concat progress ">")) + (dotimes (i (- 10 percent)) + (setq progress (concat progress " "))) + (setq progress (concat progress "]")) + (setq emms-playing-time-string progress)))) + (t ; `time' style + (setq emms-playing-time-string + (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)))))) + (setq emms-playing-time-string + (format emms-playing-time-display-format + emms-playing-time-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/lisp/emms-playlist-limit.el b/lisp/emms-playlist-limit.el new file mode 100644 index 0000000..b79d45c --- /dev/null +++ b/lisp/emms-playlist-limit.el @@ -0,0 +1,177 @@ +;;; emms-playlist-limit.el --- Limit playlist by various info + +;; Copyright (C) 2007 William Xu + +;; Author: William Xu +;; 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. + +;;; Code: + +(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 operations." + :type 'symbol + :group 'emms-playing-limit) + +(defvar emms-playlist-limit-enabled-p nil + "If non-nil, emms playlist limit is enabled.") + +(defun emms-playlist-limit (arg) + "Turn on emms playlist limit if ARG is positive, off otherwise." + (interactive "p") + (if (and arg (> arg 0)) + (progn + (setq emms-playlist-limit-enabled-p t) + (add-hook 'emms-playlist-source-inserted-hook + 'emms-playlist-limit-insert)) + (setq emms-playlist-limit-enabled-p nil) + (remove-hook 'emms-playlist-source-inserted-hook + 'emms-playlist-limit-insert))) + +;;;###autoload +(defun emms-playlist-limit-enable () + "Turn on emms playlist limit." + (interactive) + (emms-playlist-limit 1) + (message "emms playlist limit enabled")) + +;;;###autoload +(defun emms-playlist-limit-disable () + "Turn off emms playlist limit." + (interactive) + (emms-playlist-limit -1) + (message "emms playlist limit disabled")) + +;;;###autoload +(defun emms-playlist-limit-toggle () + "Toggle emms playlist limit." + (interactive) + (if emms-playlist-limit-enabled-p + (emms-playlist-limit-disable) + (emms-playlist-limit-enable))) + +(defmacro define-emms-playlist-limit (attribute) + "Macro for defining emms playlist limit functions." + `(defun ,(intern (format "emms-playlist-limit-to-%s" attribute)) (regexp) + ,(format "Limit to playlists that have %s that matches REGEXP." attribute) + (interactive + (list + (let* ((curr + (or (emms-track-get + (emms-playlist-track-at) (quote ,attribute)) + (emms-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 (emms-track-get (emms-playlist-track-at) (quote ,attribute)))) + (emms-playlist-limit-do (quote ,attribute) 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) + +(defun emms-playlist-limit-to-all () + "Show all tracks again." + (interactive) + (emms-playlist-limit-do nil nil)) + +(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 "/ /") 'emms-playlist-limit-to-all) + + +;;; Low Level Functions + +(defvar emms-playlist-limit-tracks nil + "All tracks in playlist buffer(unlimited).") + +(defun emms-playlist-limit-insert () + "Run in `emms-playlist-source-inserted-hook'." + (with-current-emms-playlist + (emms-playlist-ensure-playlist-buffer) + (setq emms-playlist-limit-tracks + (emms-with-widened-buffer + (emms-playlist-tracks-in-region (point-min) (point-max)))))) + +;; FIXME: When user deletes some tracks, `emms-playlist-limit-tracks' +;; should be updated. +;; (defun emms-playlist-limit-clear () +;; "Run in `emms-playlist-cleared-hook'." +;; (setq emms-playlist-limit-tracks +;; (append emms-playlist-limit-tracks +;; (emms-playlist-tracks-in-region +;; (point-min) (point-max))))) + +(defun emms-playlist-limit-do (name value) + "Limit by NAME with VALUE. +e.g., + (emms-playlist-limit-do 'info-artist \"Jane Zhang\") + +When NAME is nil, show all tracks again. + +See `emms-info-mp3find-arguments' for possible options for NAME." + (with-current-emms-playlist + (emms-playlist-ensure-playlist-buffer) + (let ((curr (emms-playlist-current-selected-track)) + (tracks (emms-playlist-tracks-in-region (point-min) (point-max)))) + (erase-buffer) + (run-hooks 'emms-playlist-cleared-hook) + (if name + (mapc (lambda (track) + (let ((track-value (emms-track-get track name))) + (when (and track-value (string-match value track-value)) + (emms-playlist-insert-track track)))) + tracks) + (mapc (lambda (track) + (emms-playlist-insert-track track)) + emms-playlist-limit-tracks)) + (let ((pos (text-property-any (point-min) (point-max) + 'emms-track curr))) + (if pos + (emms-playlist-select pos) + (emms-playlist-first))) + (run-hooks 'emms-playlist-limit-hook) + (emms-playlist-mode-center-current)))) + + +(provide 'emms-playlist-limit) + +;;; emms-playlist-limit.el ends here diff --git a/lisp/emms-playlist-mode.el b/lisp/emms-playlist-mode.el new file mode 100644 index 0000000..f451712 --- /dev/null +++ b/lisp/emms-playlist-mode.el @@ -0,0 +1,614 @@ +;;; emms-playlist-mode.el --- Playlist mode for Emms. + +;; Copyright (C) 2005, 2006, 2007, 2008 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.") + +(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 + :group 'emms-playlist-mode) + +(defcustom emms-playlist-mode-window-width 25 + "*Determine the width of the Emms popup window. +The value should a positive integer." + :type 'integer + :group 'emms-playlist-mode) + +(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 + :group 'emms-playlist-mode) + +;;; -------------------------------------------------------- +;;; 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." + :group 'emms-playlist-mode) + +(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." + :group 'emms-playlist-mode) + +;;; -------------------------------------------------------- +;;; Keys +;;; -------------------------------------------------------- + +(defconst 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-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-entire-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-mode-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-clear () + "If the current buffer is an EMMS playlist buffer, clear it. +Otherwise, clear the current EMMS playlist buffer." + (interactive) + (if (and emms-playlist-buffer-p + (not (eq (current-buffer) emms-playlist-buffer))) + (let ((inhibit-read-only t)) + (widen) + (delete-region (point-min) (point-max))) + (emms-playlist-clear))) + +(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-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 () + "Visit the track at point in a `dired' buffer." + (interactive) + (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 (file-name-directory 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 +;; +;; Currently this kills as regular GNU/Emacs would and not like a +;; typical music player would. +(defun emms-playlist-mode-kill-track () + "Kill track at point." + (interactive) + (emms-with-inhibit-read-only-t + (let ((track (emms-playlist-track-at))) + (if track + (let ((track-region (emms-property-region (point) + 'emms-track))) + (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)) + (kill-line)) + (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)))) + +;; C-y +(defun emms-playlist-mode-yank () + "Yank into the playlist buffer." + (interactive) + (emms-with-inhibit-read-only-t + (goto-char (point-at-bol)) + (yank))) + +;; M-y +(defun emms-playlist-mode-yank-pop () + "Cycle through the kill-ring." + (interactive) + (emms-with-inhibit-read-only-t + (yank-pop nil))) + +;;; -------------------------------------------------------- +;;; 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 (find-file-noselect filename)) + (name (buffer-name buffer))) + (with-current-buffer buffer + (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)) + (type (emms-track-get track 'type))) + (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 (eq major-mode 'emms-playlist-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-file)) + (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 () + "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-Playlist") + + (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/lisp/emms-playlist-sort.el b/lisp/emms-playlist-sort.el new file mode 100644 index 0000000..3916c74 --- /dev/null +++ b/lisp/emms-playlist-sort.el @@ -0,0 +1,204 @@ +;;; emms-playlist-sort.el --- sort emms playlist + +;; Copyright (C) 2005, 2006, 2007, 2008 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: + +(eval-when-compile (require 'cl)) +(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." + :type 'symbol + :group 'emms-playlist-sort) + +(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 + :group 'emms-playlist-sort) + + +;;; 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) + (if current-prefix-arg + (emms-string> (emms-track-get a (quote ,attribute)) + (emms-track-get b (quote ,attribute))) + (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) + (let ((ret (time-less-p + (or (emms-track-get a 'last-played) '(0 0 0)) + (or (emms-track-get b 'last-played) '(0 0 0))))) + (if current-prefix-arg + (not ret) + ret))))) + +(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) + (let ((ret (< (or (emms-track-get a 'play-count) 0) + (or (emms-track-get b 'play-count) 0)))) + (if current-prefix-arg + (not ret) + ret))))) + +(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 "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) + 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." + (with-current-emms-playlist + (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 (text-property-any + (point-min) (point-max) 'emms-track current))) + (if pos + (emms-playlist-select pos) + (emms-playlist-first)) + ;; (emms-playlist-mode-center-current) + (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))) + (or (emms-string< album-a album-b) + (and album-a + album-b + (string= album-a album-b) + (< (string-to-number (or (emms-track-get a 'info-tracknumber) + "0")) + (string-to-number (or (emms-track-get b 'info-tracknumber) + "0"))))))) + +(defun emms-playlist-sort-by-list-p (a b) + (catch 'return + (dolist (info emms-playlist-sort-list) + (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) + (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/lisp/emms-score.el b/lisp/emms-score.el new file mode 100644 index 0000000..02e0d7e --- /dev/null +++ b/lisp/emms-score.el @@ -0,0 +1,284 @@ +;;; emms-score.el --- Scoring system for mp3player + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) + (setq emms-player-next-function 'emms-score-next-noerror) + (emms-score-load-hash) + (add-hook 'kill-emacs-hook 'emms-score-save-hash)) + (setq emms-score-enabled-p nil) + (setq emms-player-next-function 'emms-next-noerror) + (emms-score-save-hash) + (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-next-noerror () + "Run `emms-next-noerror' with score check. +See also `emms-next-noerror'." + (interactive) + (when emms-player-playing-p + (error "A track is already being played")) + (cond (emms-repeat-track + (emms-start)) + ((condition-case nil + (progn + (emms-playlist-current-select-next) + t) + (error nil)) + (if (emms-score-check-score + (emms-score-current-selected-track-filename)) + (emms-start) + (emms-score-next-noerror))) + (t + (message "No next track in playlist")))) + +(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) + (mapc (lambda (elt) + (puthash (car elt) (cdr elt) emms-score-hash)) + (read + (with-temp-buffer + (insert-file-contents emms-score-file) + (buffer-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/lisp/emms-setup.el b/lisp/emms-setup.el new file mode 100644 index 0000000..877a768 --- /dev/null +++ b/lisp/emms-setup.el @@ -0,0 +1,151 @@ +;;; emms-setup.el --- Setup script for EMMS + +;; Copyright (C) 2005, 2006, 2007 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) + "*Default list of players for emms-setup." + :group 'emms-setup + :type 'list) + +;;;###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)) + +;;;###autoload +(defun emms-standard () + "An Emms setup script. +Everything included in the `emms-minimalistic' setup, the Emms +interactive playlist mode, reading information from tagged +audio files, and a metadata cache." + ;; include + (emms-minimalistic) + ;; define + (eval-and-compile + (require 'emms-playlist-mode) + (require 'emms-info) + (require 'emms-info-mp3info) + (require 'emms-info-ogginfo) + (require 'emms-cache)) + ;; setup + (setq emms-playlist-default-major-mode 'emms-playlist-mode) + (add-to-list 'emms-track-initialize-functions 'emms-info-initialize-track) + (when (executable-find emms-info-mp3info-program-name) + (add-to-list 'emms-info-functions 'emms-info-mp3info)) + (when (executable-find emms-info-ogginfo-program-name) + (add-to-list 'emms-info-functions 'emms-info-ogginfo)) + (setq emms-track-description-function 'emms-info-track-description) + (when (fboundp 'emms-cache) ; work around compiler warning + (emms-cache 1))) + +;;;###autoload +(defun emms-all () + "An Emms setup script. +Everything included in the `emms-standard' setup and adds all the +stable features which come with the Emms distribution." + ;; include + (emms-standard) + ;; define + (eval-and-compile + (require 'emms-mode-line) + (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-lastfm)) + ;; setup + (emms-mode-line 1) + (emms-mode-line-blank) + (emms-lyrics 1) + (emms-playing-time 1)) + +;;;###autoload +(defun emms-devel () + "An Emms setup script. +Everything included in the `emms-all' setup and adds all the +features which come with the Emms distribution regardless of if +they are considered stable or not. Use this if you like living +on the edge." + ;; include + (emms-all) + ;; define + (eval-and-compile + (require 'emms-metaplaylist-mode) + (require 'emms-stream-info) + (require 'emms-score) + (require 'emms-last-played) + (require 'emms-bookmarks) + (require 'emms-history) + (require 'emms-mark) + (require 'emms-i18n) + (require 'emms-tag-editor) + (require 'emms-volume) + (require 'emms-playlist-limit)) + ;; setup + (add-hook 'emms-player-started-hook 'emms-last-played-update-current) + (emms-score 1) + (emms-playlist-limit 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)) + +(provide 'emms-setup) +;;; emms-setup.el ends here diff --git a/lisp/emms-source-file.el b/lisp/emms-source-file.el new file mode 100644 index 0000000..16a9461 --- /dev/null +++ b/lisp/emms-source-file.el @@ -0,0 +1,298 @@ +;;; emms-source-file.el --- EMMS sources from the filesystem. + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) +(eval-when-compile + (condition-case nil + (require 'locate) + (error nil))) +(require 'dired) + +(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 'string + :group 'emms-source-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) + :group 'emms-source-file) + +(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 + :group 'emms-source-file) + +(defcustom emms-source-file-gnu-find "find" + "*The program name for GNU find." + :type 'string + :group 'emms-source-file) + +;; 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)) + +;;; 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-default-directory + 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-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 '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-default-directory + 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 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 (string-match "/\\.\\.?$" (car dirs)) + (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 + (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 "sPlay URL: ") + (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))) + +;;;###autoload (autoload 'emms-play-lastfm "emms-lastfm" nil t) +;;;###autoload (autoload 'emms-add-lastfm "emms-lastfm" nil t) +(define-emms-source lastfm (lastfm-url) + "An EMMS source for Last.fm URLs, which begin with lastfm://." + (interactive "sPlay Last.fm URL: ") + (emms-playlist-insert-track (emms-track 'lastfm lastfm-url))) + + +(provide 'emms-source-file) +;;; emms-source-file.el ends here diff --git a/lisp/emms-source-playlist.el b/lisp/emms-source-playlist.el new file mode 100644 index 0000000..08f62a3 --- /dev/null +++ b/lisp/emms-source-playlist.el @@ -0,0 +1,480 @@ +;;; emms-source-playlist.el --- EMMS sources from playlist files + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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) + +;;; 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) + (funcall (emms-source-playlist-parse-sym format))) + +(defun emms-source-playlist-unparse (format playlist file) + (funcall (emms-source-playlist-unparse-sym format) playlist file)) + +(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 + (intern + (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"))))) + +(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))) + (with-temp-buffer + (emms-source-playlist-unparse format + (with-current-emms-playlist + (current-buffer)) + (current-buffer)) + (let ((backup-inhibited t)) + (write-file file)))) + +(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 + (insert-file-contents file) + (goto-char (point-min)) + (let ((format (emms-source-playlist-determine-format))) + (if format + (emms-source-playlist-parse format) + (error "Not a recognized playlist format")))))) + +;;; EMMS native playlists + +;; Format: +;; ;;; This is an EMMS playlist file. Play it with M-x emms-play-playlist +;; + +(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 "^;;; This is an EMMS playlist file"))) + +(defun emms-source-playlist-parse-native () + "Parse the native EMMS playlist in the current buffer." + (save-excursion + (goto-char (point-min)) + (read (current-buffer)))) + +(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 ";;; This is an EMMS playlist file." + " Play it with M-x emms-play-playlist\n") + (insert "(") + (let ((track (emms-source-playlist-first in)) + (firstp t)) + (while track + (if (not firstp) + (insert "\n ") + (setq firstp nil)) + (prin1 track (current-buffer)) + (setq track (emms-source-playlist-next in)))) + (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 + (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)))) + +;;; 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 () + "Parse the m3u playlist in the current buffer." + (mapcar (lambda (file) + (if (string-match "\\`http://\\|\\`mms://" file) + (emms-track 'url file) + (emms-track 'file file))) + (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 + (with-current-buffer out + (let ((track (emms-source-playlist-first in))) + (while track + (insert (emms-track-name track) ?\n) + (setq track (emms-source-playlist-next in)))))))) + +;;;###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 + (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)))) + +;;; 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 () + "Parse the pls playlist in the current buffer." + (mapcar (lambda (file) + (if (string-match "\\`http://\\|\\`mms://" file) + (emms-track 'url file) + (emms-track 'file file))) + (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 + (with-current-buffer out + (let ((pos 0)) + (insert "[playlist]\n") + (save-restriction + (narrow-to-region (point) (point)) + (let ((track (emms-source-playlist-first in))) + (while track + (setq pos (1+ pos)) + (insert "File" (number-to-string pos) "=" + (emms-track-name track) ?\n) + (setq track (emms-source-playlist-next in)))) + (goto-char (point-min)) + (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 + (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)))) + +;;; 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 + +;;; Helper functions + +(defun emms-source-playlist-first (buf) + "Return the first track in BUF. +This moves point." + (with-current-buffer buf + (condition-case nil + (progn + (emms-playlist-first) + (emms-playlist-track-at (point))) + (error + nil)))) + +(defun emms-source-playlist-next (buf) + "Return the next track in BUF. +This moves point." + (with-current-buffer buf + (condition-case nil + (progn + (emms-playlist-next) + (emms-playlist-track-at (point))) + (error + nil)))) + +;;; 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/lisp/emms-stream-info.el b/lisp/emms-stream-info.el new file mode 100644 index 0000000..324a247 --- /dev/null +++ b/lisp/emms-stream-info.el @@ -0,0 +1,744 @@ +;;; emms-stream-info.el --- Info from streaming audio + +;; Copyright (C) 2004, 2005, 2006, 2007 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-stream-info' establishes a TCP connection with the server and +;; sends an HTTP request string. The server (hopefully) responds with +;; some header information describing the streaming audio channel, +;; some audio data and then the name of the song being played (usually +;; in that order). +;; +;; Some stations like WCPE [http://wcpe.org], while giving excellent +;; broadcasts do not support title streaming over MP3 or Ogg. Using +;; this software on such stations will only result in general station +;; information and not the artist name or title of the track being +;; played. + +;;; Functionality: +;; +;; Currently supports Icecast and Shoutcast servers with Ogg and MP3 +;; streams. + +;;; Use: +;; +;; Look at the documentation strings for the three interactive +;; functions: 'emms-stream-info-get', 'emms-stream-info-message' and +;; 'emms-stream-info-insert'. + +;;; Important Notes: +;; +;; 1) This software does not parse, cache or save audio data at +;; all. This software downloads a limited amount of data from a +;; given streaming audio channel per call. This software is +;; optimized to download as little as possible from a given +;; streaming audio channel and then to immediately disconnect. +;; +;; 2) This software disregards and then discards all audio data +;; automatically after each call. +;; +;; 3) This software connects for a maximum of 10 seconds and then +;; immediately disconnects. Usually the software will disconnect +;; long before the 10 second limit is reached. +;; +;; 4) It is the responsibility of the user to read the Terms of +;; Service of the streaming audio channel before running this +;; software on that channel's service. Some streaming audio +;; channels explicitly request 3rd party applications not to +;; connect to their service. This is their prerogative. Respect it. + +;; $Id: emms-stream-info.el,v 1.8 2005/07/09 11:56:00 forcer Exp $ + +;;; Code: + +(require 'emms) + +;; A higher value for 'emms-stream-info-max' this gives us a +;; correspondingly higher chance of grabbing the title information +;; from a stream but incurs a price in the additional time it takes to +;; download. +;; +;; This value is not relevant for Ogg streams since the title info in +;; Ogg streams arrives almost immediately. +;; +;; Do not set under 30000 since the typical value of 'metaint' on most +;; streaming audio servers is either 8192 or 24576 +(defconst emms-stream-info-max 120000 + "Byte limit for downloads.") + +(defconst emms-stream-info-timeout 10 + "Seconds to timeout connection (dead or alive).") + +(defconst emms-stream-info-verbose t + "Output real-time information about the connection.") + +(defconst emms-stream-info-version + "$Revision: 1.8 $" + "Software version.") + +(defconst emms-stream-info-char-alter-regexp "[-,'=:%+&0-9A-Za-z\.()/ ]" + "Unified character alternative clause for regular expressions.") + +(defconst emms-stream-info-shoutcast-regexp + (concat emms-stream-info-char-alter-regexp ".*?") + "Regular expression for Shoutcast.") + +(defconst emms-stream-info-icecast-regexp + (concat emms-stream-info-char-alter-regexp "+") + "Regular expression for Icecast.") + +(defconst emms-stream-info-shoutcast-title-regexp + (concat "StreamTitle='\\(" emms-stream-info-shoutcast-regexp "\\)';") + "Regular expression for Shoutcast.") + +;; Reference: http://www.xiph.org/ogg/vorbis/doc/framing.html +(defconst emms-stream-info-icecast-capture-pattern "Oggs\\(.*\\)BCV" + "Regular Expression for the beggining of an Ogg bitstream page.") + +;; For all servers +(defconst emms-stream-info-stream-header-regexp + (concat emms-stream-info-char-alter-regexp "+") + "Regular expression for metainformation headers.") + +(defconst emms-stream-info-streamlist-regexp + "\\(^http://.*\\)\\|^File.=\\(http://.*\\)" + "Regular expression for streamlist URLs.") + +;; When t output debugging info +(defconst emms-stream-info-debugging nil + "If t then emms-stream-info will spill the stream into a buffer. +Set to NIL unless you want a buffer filled with binary junk.") + +(defconst emms-stream-info-debug-buffer "*emms-stream-info-debug*" + "Buffer for debugging information.") + +(defconst emms-stream-info-vocab (list "name" + "genre" + "pub" + "metaint" + "br" + "bitrate" + "description" + "public" + "audio-info") + "List of header keys.") + +(defconst emms-stream-info-format-string + "Now streaming:%s, %c %bKb/sec" + "The following %-sequences are supported: + +%b Bitrate +%s Song title and artist name +%c Station/Channel name and short description +%t Song title +%g Station/Channel genre +%a Artist name + +Note that some stations do not supply artist and song title +information.") + +(defconst emms-stream-info-format-string-notitle + "Now streaming: %c %bKb/sec %g" + "Some streaming audio stations/channels do not provide artist +and songtitle information. This string specifies an alternate +format for those stations.") + +(defconst emms-stream-info-pls-regexp ".*\.pls" + "Regular expression for a .pls streamlist file.") + +(defconst emms-stream-info-m3u-regexp ".*\.m3u" + "Regular expression for a .m3u streamlist file.") + +(defvar emms-stream-info-url nil + "Server URL.") + +(defvar emms-stream-info-port nil + "Server port.") + +(defvar emms-stream-info-found nil + "Results of our search.") + +(defvar emms-stream-info-streamlist-found nil + "Results of our streamlist search.") + +(defvar emms-stream-info-procname "emms-stream-info-process" + "Name of network connection process.") + +(defvar emms-stream-info-downloaded 0 + "Amount of stream data downloaded.") + +(defvar emms-stream-info-read-inhibit nil + "When t do not attempt to read 'emms-stream-info-found'.") + +(defvar emms-stream-info-return-hook nil + "Activated after the disconnection from the streaming audio server.") + +(defvar emms-stream-info-read-hook nil + "Activated after the disconnection from the streaming audio +server. This hook is for integration purposes, for general user +functions use 'emms-stream-info-return-hook'.") + +(defvar emms-stream-info-header-flag nil + "Non-nil means header information has been captured.") + +(defvar emms-stream-info-title-flag nil + "Non-nil means title information has been captured.") + +(defvar emms-stream-info-streamlist-flag nil + "Non-nil means streamlist information has been captured.") + +(defvar emms-stream-info-request-string nil + "String sent to streaming audio server.") + +(defun emms-stream-info-decompose-url (urlstr) + "Return a vector containing the elements of the URI URLSTR." + (let ((host nil) + (file nil) + (port nil) + (protocol nil) + (user nil) ; nil + (pass nil) ; nil + (refs nil) ; nil + (attr nil) ; nil + (full nil) + (pos 1)) + (with-temp-buffer + (insert urlstr) + (goto-char (point-min)) + (if (looking-at "http") + (progn + (forward-char 4) + (setq protocol (buffer-substring-no-properties pos (point))) + (setq pos (point)))) + (skip-chars-forward "://") + (setq pos (point)) + (skip-chars-forward "^/") + (setq host (buffer-substring pos (point))) + (if (string-match ":\\([0-9+]+\\)" host) + (setq port (string-to-number (match-string 1 host)) + host (substring host 0 (match-beginning 0)))) + (setq pos (point)) + (setq file (buffer-substring pos (point-max))) + (setq full (buffer-substring (point-min) (point-max)))) + ;; Return in format compatible with 'url-generic-parse-url'. + (vector protocol user pass host port file refs attr full))) + +;; This is our tiny state machine for keeping track across multiple +;; connections. +(defvar emms-stream-info-state-bv + (if (fboundp 'make-bool-vector) + (make-bool-vector 3 nil) + (make-vector 3 nil)) + "State of sequential connections. +true at index 0 means output formatted message. +true at index 1 means insert formatted message. +trye at index 2 means continue to next connection.") + +;; This bit is ugly and non-lispish, but asynchronous communications +;; need a state machine. Better to do it with a macro. and once +;; everything works I will too! +(defun emms-stream-info-set-message () + (aset emms-stream-info-state-bv 0 t)) +(defun emms-stream-info-unset-message () + (aset emms-stream-info-state-bv 0 nil)) +(defun emms-stream-info-message-p () + (aref emms-stream-info-state-bv 0)) + +(defun emms-stream-info-set-insert () + (aset emms-stream-info-state-bv 1 t)) +(defun emms-stream-info-unset-insert () + (aset emms-stream-info-state-bv 1 nil)) +(defun emms-stream-info-insert-p () + (aref emms-stream-info-state-bv 1)) + +(defun emms-stream-info-set-continue () + (aset emms-stream-info-state-bv 2 t)) +(defun emms-stream-info-unset-continue () + (aset emms-stream-info-state-bv 2 nil)) +(defun emms-stream-info-continue-p () + (aref emms-stream-info-state-bv 2)) + +(defun emms-stream-info-streamlist-type (str) + (if (stringp str) + (cond ((string-match emms-stream-info-pls-regexp str) + 'pls) + ((string-match emms-stream-info-m3u-regexp str) + 'm3u) + (t nil)) + nil)) + +(defun emms-stream-info-format (str format-alist) + (let ((key-list (mapcar 'car format-alist))) + (setq key-list (mapcar 'car format-alist)) + (mapc (lambda (e) + (setq str + (emms-replace-regexp-in-string + e + (cdr (assoc e format-alist)) + str))) + key-list)) + str) + +;; Output a human readable message +(defun emms-stream-info-pretty-print (&optional string-out) + "Output a human readable message. If STRING-OUT is non-nil, do +not output a message and only return a string." + (let (str + (format-string emms-stream-info-format-string) + (format-alist + (list + (cons "%b" (or (emms-stream-info-get-key "br") + (emms-stream-info-get-key "bitrate") + "")) + (cons "%s" (or (emms-stream-info-get-key "songtitle") "")) + (cons "%c" (or (emms-stream-info-get-key "name") "")) + (cons "%t" (or (emms-stream-info-get-key "title") "")) + (cons "%g" (or (emms-stream-info-get-key "genre") "")) + (cons "%a" (or (emms-stream-info-get-key "artist") "")) + (cons "%. " "")))) ; clean untreated tags + + ;; Choose alternate string format if necessary + (unless (emms-stream-info-get-key "title") + (setq format-string emms-stream-info-format-string-notitle)) + + ;; format according to the format-string + (setq str + (emms-stream-info-format + format-string + format-alist)) + + ;; Escape rougue percent signs hiding in our string. + (setq str (emms-replace-regexp-in-string "%" "%%" str)) + + ;; Either output a message or return a string. But only if it is + ;; an identifiable station/channel + (when (emms-stream-info-get-key "name") + (if string-out + str + (message "%s" str))))) + +(defun emms-stream-info-pretty-print-insert () + "Insert the formatted output of 'emms-stream-info-get' at point." + (insert (or (emms-stream-info-pretty-print t) ""))) + +(defun emms-stream-info-continue () + (emms-stream-info-unset-continue) + (if emms-stream-info-streamlist-found + (emms-stream-info-get emms-stream-info-streamlist-found + (emms-stream-info-message-p) + (emms-stream-info-insert-p) + nil) + (error "No streamlist found at URL"))) + +;; Useful +(defun list-to-string (l) + "Return a STRING which is the concatenation of the elements of +L." + (if (not l) + nil + (if (stringp (car l)) + (concat (car l) (list-to-string (cdr l))) + (list-to-string (cdr l))))) + +(defun emms-stream-info-get-key (key) + "Return STRING associated with KEY." + (unless emms-stream-info-read-inhibit + (cdr (assoc key emms-stream-info-found)))) + +(defun emms-stream-info-get-keys (keys) + "Return a list of strings associated with each key in +KEYS. KEYS should be a list of strings." + (mapcar (lambda (e) + (emms-stream-info-get-key e)) + keys)) + +;; BEGIN to END should typically be a segment of about 250 Bytes +;; length for Ogg streams. +(defun emms-stream-info-decode-ogg (begin end) + "Parse Ogg stream segment from BEGIN to END." + (let ((artist nil) + (title nil)) + + (goto-char begin) + (re-search-forward (concat "artist=\\(" + emms-stream-info-icecast-regexp + "\\)") end t) + (setq artist (emms-match-string-no-properties 1)) + + (goto-char begin) + (re-search-forward (concat "title=\\(" + emms-stream-info-icecast-regexp + "\\)") end t) + (setq title (emms-match-string-no-properties 1)) + + ;; ugh + (if (or artist title) + (list (cons "songtitle" (concat artist + (if (and artist title) + " - " + " ") + title)) + (cons "artist" artist) + (cons "title" title)) + nil))) + +;; BEGIN to END should be about 20 Bytes long +(defun emms-stream-info-decode-mp3 (begin end) + "Parse Shoutcast/Icecast-MP3 segment from BEGIN to END." + (let ((split nil) + (songtitle nil) + (artist nil) + (title nil)) + + (goto-char begin) + (setq songtitle (buffer-substring begin end) + split (split-string songtitle "-")) + + (if (cdr split) + (setq artist (car split) + title (list-to-string (cdr split)))) + + (list (cons "songtitle" songtitle) + (cons "artist" artist) + (cons "title" title)))) + +(defun emms-stream-info-filter (proc str) + "Filter function for the network process. +Argument PROC Process. +Argument STR Quanta of data." + + ;; Debugging flag dependent + (if emms-stream-info-debugging + (with-current-buffer emms-stream-info-debug-buffer + (insert str))) + + (with-temp-buffer + (setq emms-stream-info-downloaded (+ emms-stream-info-downloaded + (length str))) + + ;; Insert a quanta of data. + (insert str) + + ;; Look for headers + (unless emms-stream-info-header-flag + (mapc (lambda (term) + (goto-char (point-min)) + (if (re-search-forward + (concat (regexp-opt + (list "icy-" "ice-")) + term + ":\\(" + emms-stream-info-stream-header-regexp + "\\)") + (point-max) t) + (progn + (add-to-list 'emms-stream-info-found + (cons term + (emms-match-string-no-properties 1))) + (setq emms-stream-info-header-flag t)))) + emms-stream-info-vocab)) + + ;; Look for title + (unless emms-stream-info-title-flag + (goto-char (- (point) + (length str))) + (cond ((re-search-forward + emms-stream-info-icecast-capture-pattern + (point-max) + t) + (setq emms-stream-info-found + (append + emms-stream-info-found + (emms-stream-info-decode-ogg + (match-beginning 1) + (match-end 1)))) + (setq emms-stream-info-title-flag t)) + ;; In retrospect this section mimics input_http.c from + ;; the Xine project only that it uses buffer searching. + ((re-search-forward + emms-stream-info-shoutcast-title-regexp + (point-max) + t) + (setq emms-stream-info-found + (append emms-stream-info-found + (emms-stream-info-decode-mp3 + (match-beginning 1) + (match-end 1)))) + (setq emms-stream-info-title-flag t)))) + + ;; Too many nested conditions + (if (emms-stream-info-set-continue) + (unless emms-stream-info-streamlist-flag + (goto-char (point-min)) + (if (re-search-forward + emms-stream-info-streamlist-regexp + (point-max) t) + (progn + (setq emms-stream-info-streamlist-found + (or (emms-match-string-no-properties 1) + (emms-match-string-no-properties 2))) + (setq emms-stream-info-streamlist-flag t)))))) + + ;; Be chatty at the user + (if emms-stream-info-verbose + (message "Connection %s. Downloaded %d/%d bytes." + (process-status proc) + emms-stream-info-downloaded + emms-stream-info-max)) + + ;; Find out if we need to kill the connection + (if (or (> emms-stream-info-downloaded emms-stream-info-max) ; maxed out? + ;; Captured header and title info? + (and emms-stream-info-header-flag emms-stream-info-title-flag) + ;; Captured streamlist info? + emms-stream-info-streamlist-flag) + (emms-stream-info-kill-process proc))) + +;; Closing the connection proves to be the most difficult part of the +;; program. There is a difference in the way emacs21 vs. emacs22 +;; behave. +(defun emms-stream-info-kill-process (proc) + "Hold Emacs while trying to close the connection. +Argument PROC Process." + (while (not (equal (process-status proc) 'closed)) + (delete-process proc)) + (if (process-filter proc) + (set-process-filter proc nil)) + ;; Workaround Emacs 21 sentinel problems + (when (= emacs-major-version 21) + (emms-stream-info-after-function))) + +(defun emms-stream-info-after-function () + "Evalutated when the connection ends." + (setq emms-stream-info-read-inhibit nil) ; allow reading + (run-hooks 'emms-stream-info-read-hook) + (run-hooks 'emms-stream-info-return-hook)) + +(defun emms-stream-info-sentinel (proc ev) + "Sentinel function for network process. +Argument PROC Process. +Argument EV Event string." + ;; Workaround Emacs 21 sentinel problems + (unless (= emacs-major-version 21) + (emms-stream-info-after-function))) + +(defun emms-stream-info-make-request-string (file) + "Return a valid HTTP request string with FILE as a URI." + (concat "GET " + (if (equal file "") + "/" + file) + " HTTP/1.0\r\n" + "User-Agent: Free software (see www.gnu.org), reads title of currently playing track (discards audio).\r\n" + "Icy-MetaData:1\r\n" + "\r\n")) + +(defun emms-stream-info-parse-url (urlstring) + "Set the global variables for connecting to the streaming audio +server at URLSTRING." + (let* ((url (emms-stream-info-decompose-url urlstring)) + (hostname (elt url 3)) + (port (elt url 4)) + (file (elt url 5)) + (protocol (elt url 0))) + + (cond ((or (not (equal protocol "http")) + (equal hostname "")) + (error "Invalid URL")) + + ;; eg. "http://music.station.com:8014" + ((and (empty-string-p file) + port) + (setq emms-stream-info-port port)) + + ;; eg. "http://ogg.smgradio.com/vr96.ogg" + ((and (not (empty-string-p file)) + (or (equal port "") + (equal port nil) + (equal port 0))) + (setq emms-stream-info-port 80)) + + ;; eg. "http://audio.ibiblio.org:8010/wcpe.ogg" + ((and (not (empty-string-p file)) + port) + (setq emms-stream-info-port port)) + + (t (error "Invalid URL"))) + + (setq emms-stream-info-url hostname + emms-stream-info-request-string + (emms-stream-info-make-request-string file)))) + +(defun empty-string-p (str) + "Return t if STR is equal to the empty string." + (equal str "")) + +(defun emms-stream-info-reset-state () + (setq emms-stream-info-downloaded 0) ; restart fallback + (setq emms-stream-info-title-flag nil) ; forget title flag + (setq emms-stream-info-header-flag nil) ; forget header flag + (setq emms-stream-info-found nil) ; forget output + (setq emms-stream-info-streamlist-found nil) ; forget streamlist + (setq emms-stream-info-streamlist-flag nil) ; forget streamlist + (setq emms-stream-info-read-inhibit t) ; do not read output + + ;; Reset state machine + (emms-stream-info-unset-message) + (emms-stream-info-unset-insert) + (emms-stream-info-unset-continue) + + ;; forget hooks + (remove-hook 'emms-stream-info-return-hook + 'emms-stream-info-pretty-print) + (remove-hook 'emms-stream-info-return-hook + 'emms-stream-info-continue) + (remove-hook 'emms-stream-info-return-hook + 'emms-stream-info-pretty-print-insert)) + +;; ------------------------------------------------------------------- +;; Interactive functions +;; ------------------------------------------------------------------- + +(defun emms-stream-info-get (&optional urlstring say write cont) + "Get streaming audio server header metadata and song title from stream at URL. +Argument URLSTRING Address of streaming audio server as a string. +If URLSTRING is nil then get the latest stream played via emms. +Optional argument SAY boolean. +Optional argument WRITE boolean. +Optional argument CONT boolean." + (interactive) + + (if urlstring + (emms-stream-info-parse-url urlstring) + (and (boundp 'emms-stream-last-stream) + (fboundp 'emms-stream-url) + emms-stream-last-stream + (emms-stream-info-parse-url + (emms-stream-url emms-stream-last-stream)))) + + (emms-stream-info-reset-state) + + ;; Output formatted text as a message. + (if say + (progn + (add-hook 'emms-stream-info-return-hook + 'emms-stream-info-pretty-print) + (emms-stream-info-set-message))) + ;; Insert formatted text into the current buffer. + (if write + (progn + (add-hook 'emms-stream-info-return-hook + 'emms-stream-info-pretty-print-insert) + (emms-stream-info-set-insert))) + ;; Continue to the next connection after this one. + (if cont + (progn + (add-hook 'emms-stream-info-return-hook + 'emms-stream-info-continue) + (emms-stream-info-set-continue))) + + ;; Debugging flag dependent + (if emms-stream-info-debugging + (progn + (if (get-buffer emms-stream-info-debug-buffer) + (kill-buffer emms-stream-info-debug-buffer)) + (get-buffer-create emms-stream-info-debug-buffer))) + + ;; Open connection + (condition-case nil + (if (fboundp 'make-network-process) + (make-network-process :name emms-stream-info-procname + :buffer nil + :host emms-stream-info-url + :service emms-stream-info-port) + (open-network-stream emms-stream-info-procname + nil + emms-stream-info-url + emms-stream-info-port)) + (error + (emms-stream-info-reset-state) + (message "Error connecting to streaming audio sever at %s" + emms-stream-info-url))) + + (let ((proc (get-process emms-stream-info-procname))) + (when proc + + ;; Connection timeone + (run-at-time emms-stream-info-timeout + nil + 'emms-stream-info-kill-process + proc) + + ;; Start download + (process-send-string emms-stream-info-procname + emms-stream-info-request-string) + (set-process-sentinel proc + 'emms-stream-info-sentinel) + (set-process-filter proc + 'emms-stream-info-filter) + (unless (process-sentinel proc) + (error "No process sentinel"))))) + +;; Should be phased out. +;; (defun emms-stream-info-input-sanity (&optional urlstring) +;; (let ((type (emms-track-type (emms-playlist-selected-track)))) +;; (cond ((null urlstring) +;; (if (or (equal type 'streamlist) +;; (equal type 'url)) +;; (emms-track-name (emms-playlist-selected-track)))) +;; ((not (stringp urlstring)) +;; (error "URL must be in string format")) +;; ((stringp url) urlstring)))) + +(defun emms-stream-info-input-sanity (&optional urlstring) + (if (stringp urlstring) + urlstring + (error "URL must be in string format"))) + +(defun emms-stream-info-message (&optional urlstring) + "Get information from streaming audio server at URLSTRING. +Return a formatted message. +URLSTRING should be a string." + (interactive) + (let ((url (emms-stream-info-input-sanity urlstring))) + (cond ((equal (emms-stream-info-streamlist-type url) 'pls) + (emms-stream-info-get url t nil t)) + ((equal (emms-stream-info-streamlist-type url) 'm3u) + (emms-stream-info-get url t nil t)) + (t (emms-stream-info-get url t))))) + +;; Insertion does not work for sequential connections. +(defun emms-stream-info-insert (&optional urlstring) + "Get information from streaming audio server at URLSTRING. +Insert a formatted message at point. +URLSTRING should be a string." + (interactive) + (let ((url (emms-stream-info-input-sanity urlstring))) + (cond ((equal (emms-stream-info-streamlist-type url) 'pls) + (emms-stream-info-get url nil t t)) + ((equal (emms-stream-info-streamlist-type url) 'm3u) + (emms-stream-info-get url nil t t)) + (t (emms-stream-info-get url nil t))))) + +(provide 'emms-stream-info) + +;;; emms-stream-info.el ends here diff --git a/lisp/emms-streams.el b/lisp/emms-streams.el new file mode 100644 index 0000000..711ad6f --- /dev/null +++ b/lisp/emms-streams.el @@ -0,0 +1,652 @@ +;; emms-streams.el -- interface to add and play streams + +;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Authors: Lucas Bonnet +;; Jose A Ortega Ruiz +;; Yoni Rabkin +;; 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 +;; 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: + +;; It is part of the EMMS package + +;; Heavily based on bmk-mgr.el by Jose A Ortega Ruiz +;; thanks to you ! + +;;; Code: + +(require 'emms) +(require 'later-do) + +(defgroup emms-stream nil + "*Add and play streams with EMMS." + :group 'emms) + +(defcustom emms-stream-bookmarks-file (concat (file-name-as-directory emms-directory) "streams") + "*The file where you store your favorite emms streams." + :type 'file + :group 'emms-stream) + +(defcustom emms-stream-default-action "add" + "*The default action when you press RET in the EMMS Stream interface. +Can be either \"add\" or \"play\". The default is \"add\"." + :type 'string + :group 'emms-stream) + +(defface emms-stream-name-face '((t (:bold t :foreground nil :weight bold))) + "Face for stream names." + :group 'emms-stream) + +(defface emms-stream-url-face + '((((class color) (background dark)) + (:foreground "LightSteelBlue")) + (((class color) (background light)) + (:foreground "Blue"))) + "Face for stream URLs." + :group 'emms-stream) + +(defvar emms-stream-list nil + "The list that contains your current stream bookmarks.") + +(defvar emms-stream-buffer-name "*EMMS Streams*" + "The name of the buffer used by emms-stream interface.") + +(defvar emms-stream-play-hook nil + "*A hook run when you add or play an EMMS stream via the popup.") + +(defvar emms-stream-hook nil +"*A hook run when you call emms-streams or emms-stream-popup.") + +(defvar emms-stream-current-stream nil + "The stream currently being played. +Needed by the info method, as the track doesn't contain all the +needed info.") + +(defvar emms-stream-popup-old-conf nil + "Old window configuration.") + +(defvar emms-stream-last-stream nil + "The last stream added/played by EMMS.") + +(defvar emms-stream-playlist-buffer nil + "The EMMS playlist buffer associated with emms-streams.") + +(defcustom emms-stream-repeat-p nil + "*If non-nil, try to repeat a streamlist if it gets disconnected." + :set (function + (lambda (sym val) + (when (buffer-live-p emms-stream-playlist-buffer) + (with-current-buffer emms-stream-playlist-buffer + (setq emms-repeat-playlist val))) + (set sym val))) + :type 'boolean + :group 'emms-stream) + +;; Format: (("descriptive name" url feed-number type)) +;; +;; type could be either url, playlist, or lastfm. If url, then it +;; represents a direct IP, if streamlist it's a stream playlist, if +;; lastfm it's a lastfm station +(defvar emms-stream-default-list + '(("SomaFM: Beatblender" + "http://www.somafm.com/beatblender.pls" 1 streamlist) + ("SomaFM: Secret Agent" + "http://www.somafm.com/secretagent.pls" 1 streamlist) + ("SomaFM: Groove Salad" + "http://www.somafm.com/groovesalad.pls" 1 streamlist) + ("SomaFM: Drone Zone" + "http://www.somafm.com/dronezone.pls" 1 streamlist) + ("SomaFM: Tag's Trance" + "http://www.somafm.com/tagstrance.pls" 1 streamlist) + ("SomaFM: Indie Pop Rocks" + "http://www.somafm.com/indiepop.pls" 1 streamlist) + ("SomaFM: Doomed" + "http://www.somafm.com/doomed.pls" 1 streamlist) + ("Digitally Imported, Trance" + "http://www.di.fm/mp3/trance.pls" 1 streamlist) + ("Digitally Imported, Deephouse" + "http://www.di.fm/mp3/deephouse.pls" 1 streamlist) + ("Digitally Imported, Chillout" + "http://www.di.fm/mp3/chillout.pls" 1 streamlist) + ("Digitally Imported, Drum and Bass" + "http://www.di.fm/mp3/drumandbass.pls" 1 streamlist) + ("SKY.fm, Mostly Classical" + "http://www.sky.fm/mp3/classical.pls" 1 streamlist) + ("SKY.fm, Jazz" + "http://www.sky.fm/mp3/jazz.pls" 1 streamlist) + ("Philosomatika, Goa-Trance" + "http://www.shoutcast.com/sbin/shoutcast-playlist.pls?rn=1712&file=filename.pls" 1 streamlist) + ("Drum and Bass Radio, BassDrive" + "http://www.bassdrive.com/BassDrive.m3u" 1 streamlist) + ("Flaresound, Jazzmusique" + "http://64.236.34.196:80/stream/1016" 1 url) + ("Flaresound, Jazzmusique" + "http://205.188.234.4:8004" 2 url) + ("Flaresound, L'Electric" + "http://www.bp6.com:8002" 1 url) + ("Stangs Garage, Eclectic" + "http://www.stangsgarage.com/listen.pls" 1 streamlist) + ("DNA Lounge, Live" + "http://www.dnalounge.com/webcast/128.m3u" 1 streamlist) + ("DNA Lounge Radio" + "http://www.dnalounge.com/webcast/dnaradio.m3u" 1 streamlist) + ("Virgin Radio, The Groove" + "http://www.smgradio.com/core/audio/ogg/live.pls?service=grbb" + 1 streamlist) + ("Virgin Radio, Virgin Classic" + "http://www.smgradio.com/core/audio/ogg/live.pls?service=vcbb" + 1 streamlist) + ("Virgin Radio, Virgin 1215AM" + "http://www.smgradio.com/core/audio/ogg/live.pls?service=vrbb" + 1 streamlist) + ("Voices From Within - Words From Beyond" + "http://207.200.96.225:8024/listen.pls" 1 streamlist) + ("WCPE, Classical Music" + "http://www.ibiblio.org/wcpe/wcpe.pls" 1 streamlist) + ("PLUG: Voices of the Free Software movement" + "http://purduelug.org:8000/voices-free_software.ogg" 1 url) + ("VGamp Radio, Video Game music" + "http://vgamp.com/listen128.pls" 1 streamlist) + ("Kohina - Old school game and demo music" + "http://stream.nute.net/kohina/stream.ogg.m3u" 1 streamlist) + ("Nectarine, Demoscene Radio" + "http://www.scenemusic.eu:8002/high.ogg.m3u" 1 streamlist) + ("idobi Radio" + "http://www.idobi.com/radio/iradio.pls" 1 streamlist) + ("radio.wazee - Modern Alternative Rock" + "http://www.wazee.org/128.pls" 1 streamlist) + ("ChroniX Aggression - Loud & Clear" + "http://www.chronixradio.com/chronixaggression/listen/listen.pls" + 1 streamlist) + ("WFMU, Freeform radio" + "http://www.wfmu.org/wfmu.pls" 1 streamlist) + ("KEXP - Seattle Community Radio" + "http://kexp-mp3-128k.cac.washington.edu:8000/listen.pls" 1 streamlist) + ("KRUU-LP - Fairfield, Iowa Community Radio" + "http://kruufm.com/live.pls" 1 streamlist) + ("WBCR-LP - Berkshire Community Radio" + "http://nyc01.egihosting.com:6232/listen.pls" 1 streamlist))) + +(defvar emms-stream-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map (kbd "C-a") 'beginning-of-line) + (define-key map (kbd "C-e") 'end-of-line) + (define-key map (kbd "C-k") 'emms-stream-kill-bookmark) + (define-key map (kbd "C-y") 'emms-stream-yank-bookmark) + (define-key map (kbd "C-n") 'emms-stream-next-line) + (define-key map (kbd "C-p") 'emms-stream-previous-line) + (define-key map (kbd "Q") 'emms-stream-quit) + (define-key map (kbd "a") 'emms-stream-add-bookmark) + (define-key map (kbd "d") 'emms-stream-delete-bookmark) + (define-key map (kbd "e") 'emms-stream-edit-bookmark) + (define-key map (kbd "h") 'describe-mode) + (define-key map (kbd "n") 'emms-stream-next-line) + (define-key map (kbd "p") 'emms-stream-previous-line) + (define-key map (kbd "q") 'emms-stream-quit) + (define-key map (kbd "s") 'emms-stream-save-bookmarks-file) + (define-key map (kbd "t") 'emms-stream-toggle-default-action) +;; (define-key map (kbd "u") 'emms-stream-move-bookmark-up) + (define-key map (kbd "i") 'emms-stream-info-bookmark) + (define-key map (kbd "") 'emms-stream-previous-line) + (define-key map (kbd "") 'emms-stream-next-line) + (define-key map (kbd "") 'beginning-of-line) + (define-key map (kbd "") 'end-of-line) + (define-key map (kbd "RET") 'emms-stream-play) + map) + "Keymap for `emms-stream-menu'.") + +;;;###autoload +(defun emms-streams () + "Opens the EMMS Streams interface." + (interactive) + (kill-buffer (get-buffer-create emms-stream-buffer-name)) + (set-buffer (get-buffer-create emms-stream-buffer-name)) + (erase-buffer) + (when (string= emms-stream-default-action "play") + (emms-stream-create-playlist)) + (emms-stream-mode) + (switch-to-buffer emms-stream-buffer-name)) + +(defun emms-stream-mode () + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'emms-stream-mode) + (setq mode-name "EMMS Streams") + (use-local-map emms-stream-mode-map) + (emms-stream-init) + (set (make-local-variable 'truncate-lines) t) + (set (make-local-variable 'automatic-hscrolling) t) + (set (make-local-variable 'kill-whole-line) t) + (set (make-local-variable 'next-line-add-newlines) nil) + (goto-char 1) + (emms-stream-display) + (toggle-read-only 1) + (run-hooks 'emms-stream-hook) + (set-buffer-modified-p nil) + (message "EMMS Stream Menu")) + +(defun emms-stream-create-playlist () + "Create a new EMMS playlist and associate it with emms-streams. +This is used when `emms-stream-default-action' is \"play\"." + (save-excursion + (setq emms-stream-playlist-buffer + (emms-playlist-set-playlist-buffer (emms-playlist-new))) + (with-current-buffer emms-stream-playlist-buffer + ;; if emms-stream-repeat-p is non-nil, make sure that we + ;; continue to play the station, even if briefly disconnected + (set (make-local-variable 'emms-repeat-playlist) + emms-stream-repeat-p)))) + +(defun emms-stream-kill-playlist () + "Delete the EMMS playlist associated with emms-streams, if one exists." + (when (buffer-live-p emms-stream-playlist-buffer) + (save-excursion + (if (eq emms-stream-playlist-buffer emms-playlist-buffer) + (emms-playlist-current-kill) + (kill-buffer emms-stream-playlist-buffer))) + (setq emms-stream-playlist-buffer nil))) + +(defun emms-stream-popup-revert () + "Revert to the window-configuration from before if there is one, +otherwise just remove the special bindings from the stream menu." + (interactive) + (remove-hook 'emms-pbi-manually-change-song-hook 'emms-pbi-popup-revert) + (let ((streambuffer (get-buffer emms-stream-buffer-name))) + (when streambuffer + (save-excursion + (set-buffer streambuffer) + ;; (local-unset-key (kbd "q")) + (local-unset-key (kbd "TAB"))))) + ;; (local-unset-key (kbd "RET"))))) + (when emms-stream-popup-old-conf + (set-window-configuration emms-stream-popup-old-conf)) + (remove-hook 'emms-stream-play-hook 'emms-stream-popup-revert) + (remove-hook 'emms-stream-quit-hook 'emms-stream-popup-revert)) + +(defun emms-stream-popup (&optional popup-height) + "Pops up the stream Menu, for the new stream selection. + +POPUP-HEIGHT is the height of the new frame, defaulting to +`emms-popup-default-height'." + (interactive) + (setq popup-height (or popup-height (/ (window-height) 2))) + ;; Split the current screen, and make the stream menu popup + (let ((new-window-height (- (window-height) popup-height))) + (if (not (> new-window-height 0)) + (error "Current window too small to popup menu!")) + ;; Save the current window-configuration + (setq emms-stream-popup-old-conf (current-window-configuration)) + ;; Split and select the menu + (let ((buffer-down + (split-window-vertically new-window-height))) + (select-window buffer-down)) + + (kill-buffer (get-buffer-create emms-stream-buffer-name)) + (switch-to-buffer (get-buffer-create emms-stream-buffer-name)) + (erase-buffer) + (emms-stream-mode) + + (add-hook 'emms-stream-play-hook 'emms-stream-popup-revert) + (add-hook 'emms-stream-quit-hook 'emms-stream-popup-revert) + (local-set-key (kbd "TAB") 'emms-stream-popup-revert) + (local-set-key (kbd "RET") 'emms-stream-play) + ;; (local-set-key (kbd "q") 'delete-window) + ;; Also, forget about the whole thing if the user does something + ;; to the window-configuration + ;; (add-hook 'window-configuration-change-hook 'emms-stream-popup-forget-conf))) + )) + +(defun emms-stream-init () + (setq emms-stream-list (emms-stream-read-file emms-stream-bookmarks-file))) + +(defun emms-stream-read-file (file) + "Returns a sexp." + (let ((file (expand-file-name file))) + (if (file-readable-p file) + (with-temp-buffer + (insert-file-contents-literally file) + (goto-char (point-min)) + (read (current-buffer))) + emms-stream-default-list))) + +(defun emms-stream-save-bookmarks-file () + (interactive) + (save-excursion + (let ((buffer (find-file-noselect emms-stream-bookmarks-file))) + (set-buffer buffer) + (erase-buffer) + (insert "(") + (let ((firstp t)) + (dolist (stream emms-stream-list) + (if (not firstp) + (insert "\n ") + (setq firstp nil)) + ;; make sure type identifier is a symbol, not a string + (when (stringp (nth 3 stream)) + (setq stream (copy-alist stream)) + (setcar (nthcdr 3 stream) (intern (nth 3 stream)))) + (prin1 stream buffer))) + (insert ")\n") + (save-buffer) + (kill-buffer buffer))) + (set-buffer-modified-p nil)) + +(defun emms-stream-display-line (line) + (insert (emms-stream-name line)) + (add-text-properties (point-at-bol) (point-at-eol) + '(face emms-stream-name-face)) + (add-text-properties (point-at-bol) (point-at-eol) `(emms-stream ,line)) + (insert "\n ") + (insert (emms-stream-url line)) + (add-text-properties (point-at-bol) (point-at-eol) + '(face emms-stream-url-face)) + (insert "\n")) + +(defun emms-stream-display () + "Displays the bookmark list in the current buffer, in a human + readable way." + (mapc 'emms-stream-display-line emms-stream-list) + (goto-char (point-min))) + +;; Helper functions +(defun emms-stream-take (n list) + "Takes N elements from LIST." + (let ((idx 0) + (res '())) + (while (< idx n) + (setq res (append res (list (nth idx list)))) + (setq idx (+ idx 1))) + res)) + +(defun emms-stream-insert-at (n elt list) + "Inserts the element ELT in LIST, *before* position N. +Positions are counted starting with 0." + (let* ((n-1 (- n 1)) + (before (emms-stream-take n-1 list)) + (after (last list (- (length list) n-1)))) + (append before (list elt) after))) + +(defun emms-stream-insert-several-at (n new-list list) + "Inserts the list NEW-LIST in LIST, *before* position N. +Positions are counted starting with 0." + (let* ((n-1 (- n 1)) + (before (emms-stream-take n-1 list)) + (after (last list (- (length list) n-1)))) + (append before new-list after))) + +(defun emms-stream-look-behind () + "Return non-nil if the position behind the point is an emms-stream." + (and (not (bobp)) + (get-text-property (1- (point)) 'emms-stream))) + +(defun emms-stream-back-to-stream () + "If we are not on a stream, move backwards to the nearest one." + (unless (get-text-property (point) 'emms-stream) + (unless (emms-stream-look-behind) + (goto-char (or (previous-single-property-change (point) 'emms-stream) + (point-min)))) + (goto-char (or (previous-single-property-change (point) 'emms-stream) + (point-min))))) + +(defun emms-stream-get-bookmark-at-point () + "Returns the bookmark under point." + (emms-stream-back-to-stream) + (get-text-property (point) 'emms-stream)) + +(defun emms-stream-redisplay () + (let ((inhibit-read-only t)) + (erase-buffer) + (goto-char (point-min)) + (emms-stream-display))) + +(defun emms-stream-determine-fd (name) + "Return a feed descriptor, given NAME. +This is the count of the times NAME appears in the bookmark list, +plus one." + (let ((count 1)) + (dolist (feed emms-stream-list) + (when (string= (emms-stream-name feed) name) + (setq count (1+ count)))) + count)) + +(defun emms-stream-add-bookmark (name url fd type) + "Creates a new bookmark, and inserts it at point position. + +Don't forget to run `emms-stream-save-bookmarks-file' after !" + (interactive + (list + (read-string "Name of the bookmark: ") + (read-string "URL: ") + nil + (completing-read + "Type (url, streamlist, or lastfm): " + (mapcar #'list '("url" "streamlist" "lastfm"))))) + (unless fd (setq fd (emms-stream-determine-fd name))) + (when (stringp type) (setq type (intern type))) + (let* ((line (emms-line-number-at-pos (point))) + (index (+ (/ line 2) 1))) + (setq emms-stream-list (emms-stream-insert-at index (list name url fd type) + emms-stream-list)) + (emms-stream-redisplay) + (goto-line line))) + +(defun emms-stream-delete-bookmark () + "Deletes the bookmark under the point. + +Don't forget to save your modifications !" + (interactive) + (let ((line (emms-line-number-at-pos (point)))) + (setq emms-stream-list + (delete (emms-stream-get-bookmark-at-point) emms-stream-list)) + (emms-stream-redisplay) + (goto-line line))) + +(defun emms-stream-edit-bookmark () + "Change the information of current bookmark." + (interactive) + (let* ((bookmark (emms-stream-get-bookmark-at-point)) + (name (read-from-minibuffer "Description: " + (emms-stream-name bookmark))) + (url (read-from-minibuffer "URL: " + (emms-stream-url bookmark))) + (fd (read-from-minibuffer "Feed Descriptor: " + (int-to-string (emms-stream-fd bookmark)))) + (type (read-from-minibuffer "Type (url, streamlist, or lastfm): " + (format "%s" (emms-stream-type bookmark))))) + (emms-stream-delete-bookmark) + (emms-stream-add-bookmark name url (string-to-number fd) type))) + +(defun emms-stream-name (el) + (car el)) +(defun emms-stream-url (el) + (cadr el)) +(defun emms-stream-fd (el) + (car (cddr el))) +(defun emms-stream-type (el) + (cadr (cddr el))) + +(defun emms-stream-play () + (interactive) + (let* ((line (or (get-text-property (point) 'emms-stream) + (progn + (goto-char (or (previous-single-property-change + (point) 'emms-stream) + (point-min))) + (goto-char (or (previous-single-property-change + (point) 'emms-stream) + (point-min))) + (get-text-property (point) 'emms-stream)) + (error "No stream found at point"))) + (name (emms-stream-name line)) + (url (emms-stream-url line)) + (fd (emms-stream-fd line)) + (type (emms-stream-type line)) + (player (read (concat "emms-" emms-stream-default-action "-" + (format "%s" type))))) + (setq emms-stream-last-stream line) +;; (funcall emms-stream-default-action url) + (funcall player url) + (if (string= emms-stream-default-action "add") + (message "URL added to playlist"))) + (later-do 'emms-mode-line-alter) + (run-hooks 'emms-stream-play-hook)) + +(defun emms-stream-info-bookmark () + "Return the station and track information for the streaming audio station under point." + (interactive) + (if (fboundp 'emms-stream-info-message) + (let* ((line (get-text-property (point) 'emms-stream)) + (url (emms-stream-url line))) + (emms-stream-info-message url)) + (message "Streaming media info not available."))) + +;; Killing and yanking +(defvar emms-stream-killed-streams () + "Bookmarks that have been killed.") + +(defun emms-stream-kill-bookmark () + "Kill the current bookmark." + (interactive) + (let ((stream (emms-stream-get-bookmark-at-point))) + (setq emms-stream-list (delete stream emms-stream-list) + emms-stream-killed-streams (cons stream emms-stream-killed-streams))) + (let ((inhibit-read-only t)) + (kill-line 2))) + +(defun emms-stream-yank-bookmark () + "Yank bookmark into the streams buffer." + (interactive) + (emms-stream-back-to-stream) + (let ((inhibit-read-only t) + (streams nil)) + ;; get all valid streams + (save-restriction + (narrow-to-region (point) (point)) + (yank) + (goto-char (point-min)) + (while (and (< (point) (point-max)) + (car emms-stream-killed-streams) + (looking-at "^\\(.+\\)\n \\(.+\\)\n")) + (setq streams (cons (car emms-stream-killed-streams) streams) + emms-stream-killed-streams (cdr emms-stream-killed-streams)) + (goto-char (match-end 0))) + (delete-region (point-min) (point-max))) + ;; insert streams into list + (if streams + (let* ((line (emms-line-number-at-pos (point))) + (index (+ (/ line 2) 1))) + (setq emms-stream-list (emms-stream-insert-several-at + index streams emms-stream-list)) + (setq line (+ line (* (length streams) 2))) + (emms-stream-redisplay) + (goto-line line)) + (message "Not yanking anything")))) + +;; Navigation +(defun emms-stream-next-line () + (interactive) + (when (get-text-property (point) 'emms-stream) + (goto-char (or (next-single-property-change (point) 'emms-stream) + (point-max)))) + (goto-char (or (next-single-property-change (point) 'emms-stream) + (point-max))) + (forward-line 0)) + +(defun emms-stream-previous-line () + (interactive) + (emms-stream-back-to-stream) + (goto-char (or (previous-single-property-change (point) 'emms-stream) + (point-min))) + (goto-char (or (previous-single-property-change (point) 'emms-stream) + (point-min))) + (forward-line 0)) + +(defun emms-stream-quit () + (interactive) + (emms-stream-kill-playlist) + (kill-this-buffer) + (run-hooks 'emms-stream-quit-hook)) + +(defun emms-stream-toggle-default-action () +"Toggle between adding to the current active playlist or play +right now (and thus erase the current active playlist)." + (interactive) + (if (string= emms-stream-default-action "play") + (progn + (emms-stream-kill-playlist) + (setq emms-stream-default-action "add") + (message "Default action is now add")) + (emms-stream-create-playlist) + (setq emms-stream-default-action "play") + (message "Default action is now play"))) + +;; info part +; (define-emms-info-method emms-info-url +; :providep 'emms-info-url-providep +; :get 'emms-info-url-get) +;; :set 'emms-info-url-set) + +;; A way to get the last element. it is either the only one, or the +;; last one added by emms-add-url. so in both cases, that's what we +;; want. +;; FIXME : not working with the new design. Yrk ? +; (defun emms-stream-last-element () +; (elt emms-playlist (- (length emms-playlist) 1))) + +(defun emms-info-url-providep (track) + (if (eq (emms-track-type track) 'url) + t + nil)) + +; (defun emms-info-url-get (track) +; (make-emms-info +; :title (emms-stream-url (emms-track-get track 'metadata)) +; :artist (emms-stream-name (emms-track-get track 'metadata)) +; :album " " +; :note " " +; :year " " +; :genre " " +; :file (emms-stream-url (emms-track-get track 'metadata)))) + +;; Then you register it with emms-info, by adding it to +;; `emms-info-methods-list'. + +; (add-to-list 'emms-info-methods-list 'emms-info-url) + +(defun emms-stream-add-data-to-track (track) + (emms-track-set track 'metadata emms-stream-last-stream)) + +(add-to-list 'emms-track-initialize-functions + 'emms-stream-add-data-to-track) + +; (when (featurep 'emms-info) +; (eval-when-compile (require 'emms-info)) ; appease byte-compiler +; (add-to-list 'emms-info-methods-list 'emms-info-streamlist) +; (defun emms-info-streamlist-providep (track) +; (if (eq (emms-track-type track) 'streamlist) +; t +; nil)) +; (define-emms-info-method emms-info-streamlist ;; FIXME-PLS ? +; :providep 'emms-info-streamlist-providep ;; FIXME-PLS ? +; :get 'emms-info-url-get)) + +(provide 'emms-streams) +;;; emms-streams.el ends here diff --git a/lisp/emms-tag-editor.el b/lisp/emms-tag-editor.el new file mode 100644 index 0000000..5f9d78e --- /dev/null +++ b/lisp/emms-tag-editor.el @@ -0,0 +1,742 @@ +;;; emms-tag-editor.el --- Edit track tags. + +;; Copyright (C) 2006, 2007 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: + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'emms-tag-editor) + +;;; Code: + +(eval-when-compile + (require 'cl)) +(condition-case nil + (require 'overlay) + (error nil)) +(require 'emms) +(require 'emms-info-mp3info) +(require 'emms-playlist-mode) +(require 'emms-mark) +(require 'format-spec) + +(defvar emms-tag-editor-tags + '((info-artist . "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))) + ("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 + 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" "mp3info" + ((info-artist . "a") + (info-title . "t") + (info-album . "l") + (info-tracknumber . "n") + (info-year . "y") + (info-genre . "g") + (info-note . "c"))) + ("ogg" . emms-tag-editor-tag-ogg) + ("flac" . emms-tag-editor-tag-flac)) + "An alist used when committing changes to tags in files. +If the external program sets tags by command line options +one-by-one such as mp3info, 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 OGG file according to TRACK." + (require 'emms-info-metaflac) + (with-temp-buffer + (let (need 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")))) + '("artist" "composer" "performer" "title" "album" "tracknumber" "date" "genre" "note")) + (when (buffer-string) + (funcall #'call-process-region (point-min) (point-max) + emms-info-metaflac-program-name nil + (get-buffer-create emms-tag-editor-log-buffer) + nil + "--import-tags-from=-" + (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 "vorbiscomment" 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) + "Change TAGS in FILE, using PROGRAM. +Valid tags are given by `emms-tag-editor-tagfile-functions'." + (let (args val) + (mapc (lambda (tag) + (setq val (emms-track-get track (car tag))) + (if (and val (stringp val)) + (setq args (append (list (concat "-" (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)) + (save-excursion + (set-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-edit-track (track) + "Edit the track at point, or TRACK." + (interactive (list (emms-tag-editor-track-at))) + (if (null track) + (message "No track at point!") + (emms-tag-editor-insert-tracks (list track)))) + +(defun emms-tag-editor-edit-marked-tracks () + "Edit all tracks marked in the current buffer." + (interactive) + (let ((tracks (emms-mark-mapcar-marked-track 'emms-tag-editor-track-at t))) + (if (null tracks) + (message "No track marked!") + (emms-tag-editor-insert-tracks tracks)))) + +(defun emms-tag-editor-edit () + "Edit tags of either the track at point or all marked tracks." + (interactive) + (if (emms-mark-has-markedp) + (emms-tag-editor-edit-marked-tracks) + (emms-tag-editor-edit-track (emms-tag-editor-track-at)))) + +(defvar emms-tag-editor-mode-map + (let ((map (make-sparse-keymap))) + (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 (completing-read "Set tag: " + 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)) nil t) + (skip-chars-forward " \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 (completing-read "Replace in tag: " + 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)))) + (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" match to)) + (lambda (match) + (delete-region (- (point) (length match)) (point)) + (insert to)) + (lambda () + (if (and (save-excursion + (re-search-backward tag (line-beginning-position) t)) + (re-search-forward from (line-end-position) t)) + (match-string 0) + (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 (match-string 0)))))))) + (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 (completing-read "Tag 1: " + emms-tag-editor-tags nil t))) + (tag2 (intern (completing-read "Tag 2: " + (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) + (save-excursion + (set-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)) + (add-to-list 'registers (cons register index))) + (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))) + (if 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) + (eq (emms-track-get track 'type) 'file) + (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 + ;; 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 (boundp '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 mp3info to change tag in mp3 file + (when (and (eq (emms-track-get track 'type) 'file) + (file-writable-p (emms-track-name track)) + (setq func (assoc (file-name-extension filename) + emms-tag-editor-tagfile-functions))) + (setq exit + (if (functionp (cdr func)) + (funcall (cdr func) track) + (emms-tag-editor-tag-file track (cadr func) (nth 2 func)))) + (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)))) + (if (and (featurep 'emms-cache) + need-sync + (y-or-n-p "You have changed some track names; sync the cache? ")) + (and (fboundp 'emms-cache-sync) ; silence byte-compiler + (emms-cache-sync))) + (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 (eq (emms-track-get track 'type) 'file) + (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) + +(provide 'emms-tag-editor) +;;; Emms-tag-editor.el ends here diff --git a/lisp/emms-url.el b/lisp/emms-url.el new file mode 100644 index 0000000..99d7ad7 --- /dev/null +++ b/lisp/emms-url.el @@ -0,0 +1,109 @@ +;;; emms-url.el --- Make URL and EMMS work together well + +;; Copyright (C) 2006, 2007 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-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/lisp/emms-volume-amixer.el b/lisp/emms-volume-amixer.el new file mode 100644 index 0000000..6bee5ab --- /dev/null +++ b/lisp/emms-volume-amixer.el @@ -0,0 +1,67 @@ +;;; emms-volume-amixer.el --- a mode for changing volume using amixer + +;; Copyright (C) 2006, 2007 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. + +;;; 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-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) + +;;;###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 + "sset" emms-volume-amixer-control + (format "%d%%%s" (abs amount) + (if (< amount 0) "-" "+")))) + (if (re-search-backward "\\[\\([0-9]+%\\)\\]" nil t) + (match-string 1)))))) + +(provide 'emms-volume-amixer) + +;;; emms-volume-amixer.el ends here diff --git a/lisp/emms-volume.el b/lisp/emms-volume.el new file mode 100644 index 0000000..f894976 --- /dev/null +++ b/lisp/emms-volume.el @@ -0,0 +1,144 @@ +;;; emms-volume.el --- Volume functions and a minor mode to adjust volume easily + +;; Copyright (C) 2006, 2007 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 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) + +;; Customize group +(defgroup emms-volume nil + "Volume setting for EMMS." + :group 'emms) + +;; General volume setting related code. +(defcustom emms-volume-change-function 'emms-volume-amixer-change + "*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) + (function :tag "Lisp function")) + :group 'emms-volume) + +(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 + :group 'emms-volume) + +;;;###autoload +(defun emms-volume-raise () + "Raise the speaker volume." + (interactive) + (funcall emms-volume-change-function emms-volume-change-amount)) + +;;;###autoload +(defun emms-volume-lower () + "Lower the speaker 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/lisp/emms.el b/lisp/emms.el new file mode 100644 index 0000000..4825cbd --- /dev/null +++ b/lisp/emms.el @@ -0,0 +1,1391 @@ +;;; emms.el --- The Emacs Multimedia System + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 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 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, so you might +;; just want to use that file. + +;;; Code: + +(defvar emms-version "3.0" + "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. You need to set this!" + :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-repeat-track nil + "Non-nil, playback will repeat current track. If nil, EMMS will play +track by track normally." + :group 'emms + :type 'boolean) + +(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 make track uniq 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 default-major-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-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-updated-functions nil + "*List of functions to call when a track changes data. +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. +This is a number in seconds." + :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 "~/.emacs.d/emms" + "*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.") + + +;;; 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. +The point will be placed at the beginning of the track before +executing BODY. + +The 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)) + + +;;; 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)) + ((condition-case nil + (progn + (emms-playlist-current-select-next) + t) + (error nil)) + (emms-start)) + (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." + (interactive) + (when emms-player-playing-p + (emms-player-pause))) + +(defun emms-seek (seconds) + "Seek the current player SECONDS seconds. +This can be a floating point number for sub-second fractions. +It can also be negative to seek backwards." + (interactive "nSeconds to seek: ") + (emms-ensure-player-playing-p) + (emms-player-seek seconds)) + +(defun emms-seek-to (seconds) + "Seek the current player to SECONDS seconds. +This can be a floating point number for sub-second fractions. +It can also be negative to seek backwards." + (interactive "nSeconds to seek to: ") + (emms-ensure-player-playing-p) + (emms-player-seek-to 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 () + "Uniq the current playlist. +This uses `emms-playlist-uniq-function'." + (interactive) + (with-current-emms-playlist + (save-excursion + (funcall emms-playlist-uniq-function)))) + +(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"))) + + +;;; Compatibility functions + +(require 'emms-compat) + + +;;; 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-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." + (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)))) + + +;;; 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 when 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))) + (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 (sort buf-list + #'(lambda (lbuf rbuf) + (< (length (car lbuf)) + (length (car rbuf))))))))) + (completing-read "Playlist buffer to make current: " + 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 (interactive-p) + (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 (interactive-p) + (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. +If no playlist exists, a new one is generated." + (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 when 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 anyways, 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" + (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))))) + +;;; 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' +do 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 `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-player-start (track) + "Start playing TRACK." + (if emms-player-playing-p + (error "A player is already playing") + (let ((player (emms-player-for track))) + (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 diff --git a/lisp/jack.el b/lisp/jack.el new file mode 100644 index 0000000..e1e53fd --- /dev/null +++ b/lisp/jack.el @@ -0,0 +1,368 @@ +;;; jack.el --- Jack Audio Connection Kit support + +;; Copyright (C) 2005, 2006, 2007 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 jack () + "Jack Audio Connection Kit" + :group 'processes) + +(defcustom jack-rc '("~/.jackdrc" "/etc/jackd.conf") + "*JACK run control paths." + :group 'jack + :type 'repeat) + +(defcustom 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." + :group 'jack + :type 'boolean) + +(defcustom jack-program (executable-find "jackd") + "*JACK executable path." + :group 'jack + :type 'file) + +(defcustom jack-sample-rate 44100 + "*Default sampling rate for JACK." + :group 'jack + :type 'integer) + +(defcustom jack-period-size 128 + "*Period size to use when launching new JACK process." + :group 'jack + :type 'integer) + +(defcustom jack-alsa-device nil + "*ALSA soundcard to use." + :group 'jack + :type '(choice (const :tag "Ask" nil) string)) + +(defun 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 jack-alsa-device () + (or jack-alsa-device (jack-read-alsa-device))) + +(defcustom jack-output-buffer-name "*JACK output*" + "*Output buffer name." + :group 'jack + :type 'string) + +(defun jack-args () + "Return a list of startup arguments to use. +First element is the executable path." + (or (and jack-use-jack-rc + (catch 'rc-found + (let ((files (mapcar 'expand-file-name 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 jack-program + "-v" + "-R" + "-dalsa" + (format "-d%s" (jack-alsa-device)) + (format "-r%d" jack-sample-rate) + (format "-p%d" jack-period-size)))) + +(defcustom jack-set-rtlimits t + "*Use set_rtlimits (if available) to gain realtime priorities if -R +is given in jackd command-line." + :group 'jack + :type 'boolean) + +(defcustom jack-set-rtlimits-program (executable-find "set_rtlimits") + "*Path to set_rtlimits." + :group 'jack + :type 'file) + +(defun jack-maybe-rtlimits (args) + (if (and jack-set-rtlimits + (or (member "-R" args) (member "--realtime" args)) + (file-exists-p jack-set-rtlimits-program)) + (append (list jack-set-rtlimits-program "-r") args) + args)) + +(defvar jack-process nil) + +(defvar jack-load 0) + +(defvar jack-max-usecs 0) + +(defvar jack-spare 0) + +(defun jack-output-buffer () + (or (get-buffer jack-output-buffer-name) + (with-current-buffer (get-buffer-create jack-output-buffer-name) + (setq major-mode 'jack-mode + mode-name "JACK" + mode-line-format (copy-tree mode-line-format)) + (setcar (nthcdr 16 mode-line-format) + `(:eval (format "load:%.2f" jack-load))) + (add-hook 'kill-buffer-hook 'jack-kill nil t) + (current-buffer)))) + +(defvar jack-xruns nil) + +(defun 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 jack-load (string-to-number (match-string 1 string)) + jack-max-usecs (string-to-number (match-string 2 string)) + 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)) jack-xruns) + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point)))))) + (when moving (goto-char (process-mark proc)))))) + +(defun jack-running-p () + (and jack-process (processp jack-process) + (eq (process-status jack-process) 'run))) + +(defcustom jack-started-hook nil + "*Hook run when `jack-start' successfully started a new JACK intance." + :group 'jack + :type 'hook) + +(defun jack-start () + "Start the JACK process." + (interactive) + (if (jack-running-p) (error "JACK already running") + (setq jack-process + (apply 'start-process "jack" (jack-output-buffer) + (jack-maybe-rtlimits (jack-args)))) + (set-process-filter jack-process #'jack-filter) + (run-hooks 'jack-started-hook) + (switch-to-buffer (jack-output-buffer)))) + +(defun jack-kill () + "Kill the currently running JACK process." + (interactive) + (when (jack-running-p) (delete-process jack-process)) + (setq jack-process nil)) + +(defun jack-restart () + "Restart JACK." + (interactive) + (if (jack-running-p) (jack-kill)) + (sit-for 0) + (jack-start)) + +(defun 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 jack-ports (program) + (cdr (assoc program (jack-list)))) + +(defun jack-get-port-connections (program port) + (cdr (assoc 'connections (cdr (assoc port (jack-ports program)))))) + +(defun jack-get-port-properties (program port) + (cdr (assoc 'properties (cdr (assoc port (jack-ports program)))))) + +(defun jack-get-direction (program port) + (let ((props (jack-get-port-properties program port))) + (or (car (member 'output props)) + (car (member 'input props)) + (error "Neither input nor output port")))) + +(defun jack-read-program (prompt &optional predicate) + (let ((progs (if (functionp predicate) + (emms-remove-if-not predicate (jack-list)) + (jack-list)))) + (unless progs (error "No matching JACK clients found")) + (if (< (length progs) 2) (caar progs) + (completing-read prompt progs nil t)))) + +(defun 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 jack-read-port (program prompt &optional predicate) + (let ((ports (if (functionp predicate) + (emms-remove-if-not predicate (jack-ports program)) + (jack-ports program)))) + (if (< (length ports) 2) (caar ports) + (completing-read prompt ports nil t (jack-unique-port-name (mapcar 'car ports)))))) + +(defun 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 (jack-read-program "Connect: ")) + (port (jack-read-port prog (format "Connect %s port: " prog))) + (to-type (if (eq (jack-get-direction prog port) 'input) 'output 'input)) + (to-prog (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 (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 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 (jack-read-program + "Disconnect: " + (lambda (prog) + (emms-find-if (lambda (port) (assoc 'connections (cdr port))) + (cdr prog))))) + (port (jack-read-port prog + (format "Disconnect %s port: " prog) + (lambda (port) + (assoc 'connections (cdr port))))) + (connections (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 (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 'jack) +;;; jack.el ends here diff --git a/lisp/later-do.el b/lisp/later-do.el new file mode 100644 index 0000000..ecc4197 --- /dev/null +++ b/lisp/later-do.el @@ -0,0 +1,76 @@ +;;; later-do.el --- execute lisp code ... later + +;; Copyright (C) 2004, 2005, 2006, 2007 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. + +;;; Code: + +(defvar later-do-version "0.2emms2 (2005-09-20)" + "Version string of later-do.") + +(defgroup later-do nil + "*Running functions ... later!" + :prefix "later-do-" + :group 'development) + +(defcustom later-do-interval 0.5 + "How many seconds to wait between running events." + :group 'later-do + :type 'number) + +(defvar later-do-list nil + "A list of functions to be called lateron.") + +(defvar later-do-timer nil + "The timer that later-do uses.") + +(defun 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 `later-do' is guaranteed to be executed in the +sequence it was added." + (setq later-do-list (nconc later-do-list + (list (cons function args)))) + (unless later-do-timer + (setq later-do-timer + (run-with-timer later-do-interval nil 'later-do-timer)))) + +(defun later-do-timer () + "Run the next element in `later-do-list', or do nothing if it's +empty." + (if (null later-do-list) + (setq later-do-timer nil) + (let ((fun (caar later-do-list)) + (args (cdar later-do-list))) + (setq later-do-list (cdr later-do-list)) + (unwind-protect + (apply fun args) + (setq later-do-timer (run-with-timer later-do-interval + nil + 'later-do-timer)))))) + +(provide 'later-do) +;;; later-do.el ends here diff --git a/lisp/ogg-comment.el b/lisp/ogg-comment.el new file mode 100644 index 0000000..46dd50a --- /dev/null +++ b/lisp/ogg-comment.el @@ -0,0 +1,270 @@ +;;; ogg-comment.el --- Read Ogg-Vorbis file headers. + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Filename: ogg-comment.el +;; Version: $Revision: 1.5 $ +;; Author: lawrence mitchell +;; Maintainer: lawrence mitchell +;; Created: 2003-09-26 +;; Keywords: music + +;; 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. http://www.gnu.org/copyleft/gpl.html +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If you did not, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: +;; This file provides a minimal interface to reading the "comment" +;; section from an Ogg-Vorbis stream as defined in +;; It relies on all the comments being in the first 28kilobytes of +;; the file, thus removing the need to read the whole ogg file into +;; an Emacs buffer. + +;; The implementation is rather "byte-oriented", due to the way the +;; Ogg-Vorbis file headers are specified. Any improvements in making +;; the implementation more emacsy would be welcomed. + +;;; Installation: +;; To use, put this file somewhere in your `load-path' and do +;; (require 'ogg-comment). +;; You can then read ogg comments from a file by doing: +;; M-x oggc-show-header RET. + +;;; History: +;; + +;;; TODO: +;; o Read setup header, to get bitrate and such like. +;; o Make writing comments possible. + +;;; Code: +(eval-when-compile + (defvar it) + (require 'cl)) + +(defconst oggc-ogg-header "OggS" + "The string indicating the start of an Ogg stream.") + +(defconst oggc-identification-header "\001vorbis" + "The string indicating the start of the Ogg identification header.") + +(defconst oggc-comment-header "\003vorbis" + "The string indicating the start of the Ogg comment header.") + +(defconst oggc-setup-header "\005vorbis" + "The string indicating the start of the Ogg setup header.") + +(defconst oggc-code-book-pattern "BCV" + "The string indicating the start of an Ogg code book.") + +(defconst oggc-version "$Revision: 1.5 $" + "Ogg-comment's version number.") + +(defmacro with-part-of-file (file-spec &rest body) + "Execute BODY in a buffer containing part of FILE. + +BEG and END are as `insert-file-contents' (q.v.). + +\(fn (FILE &optional BEG END) &rest BODY)" + (let (file beg end) + (setq file (pop file-spec)) + (and file-spec (setq beg (pop file-spec))) + (and file-spec (setq end (pop file-spec))) + `(with-temp-buffer + (insert-file-contents-literally ,file nil ,beg ,end) + (goto-char (point-min)) + ,@body))) + +(defmacro aif (test-form then &rest else) + "Like `if', but with `it' bound to the result of TEST-FORM. +`it' is accessible in the THEN and ELSE clauses. + +Warning, non-hygienic by design. + +\(fn TEST-FORM THEN &rest ELSE)" + `(let ((it ,test-form)) + (if it + ,then + ,@else))) + +(defun oggc-split-comment (comment) + "Split Ogg COMMENT into a (name, value) pair. + +If possible (`ccl-execute-on-string' and `ccl-decode-mule-utf-8' +available), COMMENT is decoded into utf-8. + +The name-part is converted to lowercase, to make sure case-differences +are ignored." + (setq comment (split-string comment "=")) + (list (downcase (car comment)) + (oggc-decode-utf-8 (or (cadr comment) + "")))) + +(defun oggc-encode-utf-8 (string) + "Encode STRING into utf-8." + (if (and (fboundp 'ccl-execute-on-string) + (boundp 'ccl-encode-mule-utf-8)) + (ccl-execute-on-string ccl-encode-mule-utf-8 + (make-vector 9 nil) + string) + string)) + +(defun oggc-decode-utf-8 (string) + "Decode STRING from utf-8." + (if (and (fboundp 'ccl-execute-on-string) + (boundp 'ccl-decode-mule-utf-8)) + (ccl-execute-on-string ccl-decode-mule-utf-8 + (make-vector 9 nil) + string) + string)) + +(defun oggc-read-string (length) + "Read a string from `point' of LENGTH characters. + +Advances to (+ LENGTH (point))." + (buffer-substring-no-properties + (point) (goto-char (+ length (point))))) + +(defun oggc-valid-ogg-stream-p () + "Return non-nil if the current buffer contains a valid Ogg-Vorbis stream." + (or (search-forward oggc-ogg-header (min 100 (point-max)) t) + (error "File does not appear to be a valid ogg stream")) + (or (search-forward oggc-identification-header (min 300 (point-max)) t) + (error "Not a valid ogg stream"))) + +(defun oggc-comment-exists-p () + "Return the value of `point' where comments are found in the current buffer." + (let ((max (save-excursion + (search-forward oggc-setup-header nil t) + (point)))) + (and (search-forward oggc-comment-header max t) + (point)))) + +(defun oggc-bytes-to-lsb-int (n) + "Read N bytes as a LSB integer." + (loop for i from 0 below n + sum (* (expt 256 i) + (prog1 (char-after) + (forward-char 1))))) + +(defun oggc-int-to-lsb-bytes (int n) + "Return a list of N bytes encoding INT as a LSB integer." + (nreverse (loop for i downfrom (1- n) to 0 + for exp = (expt 256 i) + collect (floor int exp) + when (<= exp int) + do (setq int (/ int exp))))) + +(defun oggc-construct-comment-field (comment-list) + "Construct an Ogg-Vorbis comment header from COMMENT-LIST. + +COMMENT-LIST should be of the form (TITLE VALUE). +VALUE is encoded into UTF-8 if possible (`ccl-execute-on-string' and +`ccl-decode-mule-utf-8' available). The length of the thus ensuing +comment header is prepended to the string as a 4-byte lsb int." + (let* ((title (pop comment-list)) + (value (pop comment-list))) + (setq title (concat title "=" + (oggc-encode-utf-8 value))) + (concat (oggc-int-to-lsb-bytes (length title) 4) + title))) + +(defun oggc-construct-vendor (vendor) + "Construct a vendor string from VENDOR." + (concat (oggc-int-to-lsb-bytes (length vendor) 4) + vendor)) + +;;; FIXME: This doesn't work!! +;;; Somehow, we need to modify one of the code-book headers to make +;;; note of the fact that the comment has changed. I can't see in +;;; the spec what needs to be done. +;;; This doesn't work even for the case where we don't change the +;;; length of the comment, just one character, e.g. tracknumber=1 to +;;; tracknumber=2. +(defun oggc-write-comments (file comments) + "Write COMMENTS to FILE. + +COMMENTS should be as for `oggc-construct-comment-string' (q.v.)." + (with-temp-buffer + ;; dog slow for large files. + ;; an alternative would be to use head/tail/cut as needed to + ;; split the file up and put it back together again. + (insert-file-contents-literally file) + (when (oggc-valid-ogg-stream-p) + (when (oggc-comment-exists-p) + (let ((vendor (save-excursion (oggc-read-vendor)))) + (delete-region (point) (progn (oggc-read-comments (point)) + (point))) + (insert (oggc-construct-vendor vendor) + (oggc-construct-comment-string comments)))) + (write-region nil nil file)))) + +(defun oggc-construct-comment-string (comments) + "Construct a string off Ogg-Vorbis comment headers from COMMENTS. + +COMMENTS should be an alist of the form: + ((TITLE-1 VALUE-1) + (TITLE-2 VALUE-2))" + (concat (oggc-int-to-lsb-bytes (length comments) 4) + (mapconcat #'oggc-construct-comment-field comments ""))) + +(defun oggc-read-vendor () + "Read an Ogg-Vorbis vendor string from the current buffer." + (let ((length (oggc-bytes-to-lsb-int 4))) + (oggc-read-string length))) + +(defun oggc-read-comments (pos) + "Read Ogg-Vorbis comments, starting POS bytes from `point-min'." + (goto-char pos) + (let ((vendor (oggc-read-vendor)) + (length (oggc-bytes-to-lsb-int 4)) + comments) + (loop repeat length + for this-length = (oggc-bytes-to-lsb-int 4) + for c = (oggc-read-string this-length) do + (push (oggc-split-comment c) comments)) + (list vendor (nreverse comments)))) + +(defun oggc-read-header (file) + "Read an Ogg-Vorbis header from FILE." + (with-part-of-file (file 0 + ;; Lets hope that the comments + ;; aren't more than 28KB long. + (* 1024 28)) + (when (oggc-valid-ogg-stream-p) + (aif (oggc-comment-exists-p) + (oggc-read-comments it))))) + +(defun oggc-pretty-print-header (header) + "Print Ogg HEADER readably in a temporary buffer." + (let ((vendor (car header)) + (comments (cadr header))) + (switch-to-buffer (get-buffer-create "*comments*")) + (erase-buffer) + (insert "Vendor: "vendor "\n") + (mapc #'(lambda (s) + (insert (car s) ": " (cadr s) "\n")) + comments))) + +;;;###autoload +(defun oggc-show-header (file) + "Show a pretty printed representation of the Ogg Comments in FILE." + (interactive "FFile: ") + (oggc-pretty-print-header (oggc-read-header file))) + +(provide 'ogg-comment) + +;;; ogg-comment.el ends here diff --git a/lisp/tq.el b/lisp/tq.el new file mode 100644 index 0000000..8daa9a2 --- /dev/null +++ b/lisp/tq.el @@ -0,0 +1,172 @@ +;;; tq.el --- utility to maintain a transaction queue + +;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. + +;; Author: Scott Draves +;; Maintainer: FSF +;; Adapted-By: ESR +;; Keywords: extensions + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file manages receiving a stream asynchronously, parsing it +;; into transactions, and then calling the associated handler function +;; upon the completion of each transaction. + +;; Our basic structure is the queue/process/buffer triple. Each entry +;; of the queue part is a list of question, regexp, closure, and +;; function that is consed to the last element. + +;; A transaction queue may be created by calling `tq-create'. + +;; A request may be added to the queue by calling `tq-enqueue'. If +;; the `delay-question' argument is non-nil, we will wait to send the +;; question to the process until it has finished sending other input. +;; Otherwise, once a request is enqueued, we send the given question +;; immediately to the process. + +;; We then buffer bytes from the process until we see the regexp that +;; was provided in the call to `tq-enqueue'. Then we call the +;; provided function with the closure and the collected bytes. If we +;; have indicated that the question from the next transaction was not +;; sent immediately, send it at this point, awaiting the response. + +;;; Code: + +;;; Accessors + +;; This part looks like (queue . (process . buffer)) +(defun tq-queue (tq) (car tq)) +(defun tq-process (tq) (car (cdr tq))) +(defun tq-buffer (tq) (cdr (cdr tq))) + +;; The structure of `queue' is as follows +;; ((question regexp closure . fn) +;; ) +;; question: string to send to the process +(defun tq-queue-head-question (tq) (car (car (tq-queue tq)))) +;; regexp: regular expression that matches the end of a response from +;; the process +(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) +;; closure: additional data to pass to the function +(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) +;; fn: function to call upon receiving a complete response from the +;; process +(defun tq-queue-head-fn (tq) (cdr (cdr (cdr (car (tq-queue tq)))))) + +;; Determine whether queue is empty +(defun tq-queue-empty (tq) (not (tq-queue tq))) + +;;; Core functionality + +;;;###autoload +(defun tq-create (process) + "Create and return a transaction queue communicating with PROCESS. +PROCESS should be a subprocess capable of sending and receiving +streams of bytes. It may be a local process, or it may be connected +to a tcp server on another machine." + (let ((tq (cons nil (cons process + (generate-new-buffer + (concat " tq-temp-" + (process-name process))))))) + (set-process-filter process + `(lambda (proc string) + (tq-filter ',tq string))) + tq)) + +(defun tq-queue-add (tq question re closure fn) + (setcar tq (nconc (tq-queue tq) + (cons (cons question (cons re (cons closure fn))) nil))) + 'ok) + +(defun tq-queue-pop (tq) + (setcar tq (cdr (car tq))) + (let ((question (tq-queue-head-question tq))) + (condition-case nil + (process-send-string (tq-process tq) question) + (error nil))) + (null (car tq))) + +(defun tq-enqueue (tq question regexp closure fn &optional delay-question) + "Add a transaction to transaction queue TQ. +This sends the string QUESTION to the process that TQ communicates with. + +When the corresponding answer comes back, we call FN with two +arguments: CLOSURE, which may contain additional data that FN +needs, and the answer to the question. + +REGEXP is a regular expression to match the entire answer; +that's how we tell where the answer ends. + +If DELAY-QUESTION is non-nil, delay sending this question until +the process has finished replying to any previous questions. +This produces more reliable results with some processes." + (let ((sendp (or (not delay-question) + (not (tq-queue tq))))) + (tq-queue-add tq (unless sendp question) regexp closure fn) + (when sendp + (process-send-string (tq-process tq) question)))) + +(defun tq-close (tq) + "Shut down transaction queue TQ, terminating the process." + (delete-process (tq-process tq)) + (kill-buffer (tq-buffer tq))) + +(defun tq-filter (tq string) + "Append STRING to the TQ's buffer; then process the new data." + (let ((buffer (tq-buffer tq))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char (point-max)) + (insert string) + (tq-process-buffer tq))))) + +(defun tq-process-buffer (tq) + "Check TQ's buffer for the regexp at the head of the queue." + (let ((buffer (tq-buffer tq))) + (when (buffer-live-p buffer) + (set-buffer buffer) + (if (= 0 (buffer-size)) () + (if (tq-queue-empty tq) + (let ((buf (generate-new-buffer "*spurious*"))) + (copy-to-buffer buf (point-min) (point-max)) + (delete-region (point-min) (point)) + (pop-to-buffer buf nil) + (error "Spurious communication from process %s, see buffer %s" + (process-name (tq-process tq)) + (buffer-name buf))) + (goto-char (point-min)) + (if (re-search-forward (tq-queue-head-regexp tq) nil t) + (let ((answer (buffer-substring (point-min) (point)))) + (delete-region (point-min) (point)) + (unwind-protect + (condition-case nil + (funcall (tq-queue-head-fn tq) + (tq-queue-head-closure tq) + answer) + (error nil)) + (tq-queue-pop tq)) + (tq-process-buffer tq)))))))) + +(provide 'tq) + +;;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79 +;;; tq.el ends here diff --git a/ogg-comment.el b/ogg-comment.el deleted file mode 100644 index 46dd50a..0000000 --- a/ogg-comment.el +++ /dev/null @@ -1,270 +0,0 @@ -;;; ogg-comment.el --- Read Ogg-Vorbis file headers. - -;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. - -;; Filename: ogg-comment.el -;; Version: $Revision: 1.5 $ -;; Author: lawrence mitchell -;; Maintainer: lawrence mitchell -;; Created: 2003-09-26 -;; Keywords: music - -;; 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. http://www.gnu.org/copyleft/gpl.html -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If you did not, write to the Free Software -;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA -;; 02110-1301 USA - -;;; Commentary: -;; This file provides a minimal interface to reading the "comment" -;; section from an Ogg-Vorbis stream as defined in -;; It relies on all the comments being in the first 28kilobytes of -;; the file, thus removing the need to read the whole ogg file into -;; an Emacs buffer. - -;; The implementation is rather "byte-oriented", due to the way the -;; Ogg-Vorbis file headers are specified. Any improvements in making -;; the implementation more emacsy would be welcomed. - -;;; Installation: -;; To use, put this file somewhere in your `load-path' and do -;; (require 'ogg-comment). -;; You can then read ogg comments from a file by doing: -;; M-x oggc-show-header RET. - -;;; History: -;; - -;;; TODO: -;; o Read setup header, to get bitrate and such like. -;; o Make writing comments possible. - -;;; Code: -(eval-when-compile - (defvar it) - (require 'cl)) - -(defconst oggc-ogg-header "OggS" - "The string indicating the start of an Ogg stream.") - -(defconst oggc-identification-header "\001vorbis" - "The string indicating the start of the Ogg identification header.") - -(defconst oggc-comment-header "\003vorbis" - "The string indicating the start of the Ogg comment header.") - -(defconst oggc-setup-header "\005vorbis" - "The string indicating the start of the Ogg setup header.") - -(defconst oggc-code-book-pattern "BCV" - "The string indicating the start of an Ogg code book.") - -(defconst oggc-version "$Revision: 1.5 $" - "Ogg-comment's version number.") - -(defmacro with-part-of-file (file-spec &rest body) - "Execute BODY in a buffer containing part of FILE. - -BEG and END are as `insert-file-contents' (q.v.). - -\(fn (FILE &optional BEG END) &rest BODY)" - (let (file beg end) - (setq file (pop file-spec)) - (and file-spec (setq beg (pop file-spec))) - (and file-spec (setq end (pop file-spec))) - `(with-temp-buffer - (insert-file-contents-literally ,file nil ,beg ,end) - (goto-char (point-min)) - ,@body))) - -(defmacro aif (test-form then &rest else) - "Like `if', but with `it' bound to the result of TEST-FORM. -`it' is accessible in the THEN and ELSE clauses. - -Warning, non-hygienic by design. - -\(fn TEST-FORM THEN &rest ELSE)" - `(let ((it ,test-form)) - (if it - ,then - ,@else))) - -(defun oggc-split-comment (comment) - "Split Ogg COMMENT into a (name, value) pair. - -If possible (`ccl-execute-on-string' and `ccl-decode-mule-utf-8' -available), COMMENT is decoded into utf-8. - -The name-part is converted to lowercase, to make sure case-differences -are ignored." - (setq comment (split-string comment "=")) - (list (downcase (car comment)) - (oggc-decode-utf-8 (or (cadr comment) - "")))) - -(defun oggc-encode-utf-8 (string) - "Encode STRING into utf-8." - (if (and (fboundp 'ccl-execute-on-string) - (boundp 'ccl-encode-mule-utf-8)) - (ccl-execute-on-string ccl-encode-mule-utf-8 - (make-vector 9 nil) - string) - string)) - -(defun oggc-decode-utf-8 (string) - "Decode STRING from utf-8." - (if (and (fboundp 'ccl-execute-on-string) - (boundp 'ccl-decode-mule-utf-8)) - (ccl-execute-on-string ccl-decode-mule-utf-8 - (make-vector 9 nil) - string) - string)) - -(defun oggc-read-string (length) - "Read a string from `point' of LENGTH characters. - -Advances to (+ LENGTH (point))." - (buffer-substring-no-properties - (point) (goto-char (+ length (point))))) - -(defun oggc-valid-ogg-stream-p () - "Return non-nil if the current buffer contains a valid Ogg-Vorbis stream." - (or (search-forward oggc-ogg-header (min 100 (point-max)) t) - (error "File does not appear to be a valid ogg stream")) - (or (search-forward oggc-identification-header (min 300 (point-max)) t) - (error "Not a valid ogg stream"))) - -(defun oggc-comment-exists-p () - "Return the value of `point' where comments are found in the current buffer." - (let ((max (save-excursion - (search-forward oggc-setup-header nil t) - (point)))) - (and (search-forward oggc-comment-header max t) - (point)))) - -(defun oggc-bytes-to-lsb-int (n) - "Read N bytes as a LSB integer." - (loop for i from 0 below n - sum (* (expt 256 i) - (prog1 (char-after) - (forward-char 1))))) - -(defun oggc-int-to-lsb-bytes (int n) - "Return a list of N bytes encoding INT as a LSB integer." - (nreverse (loop for i downfrom (1- n) to 0 - for exp = (expt 256 i) - collect (floor int exp) - when (<= exp int) - do (setq int (/ int exp))))) - -(defun oggc-construct-comment-field (comment-list) - "Construct an Ogg-Vorbis comment header from COMMENT-LIST. - -COMMENT-LIST should be of the form (TITLE VALUE). -VALUE is encoded into UTF-8 if possible (`ccl-execute-on-string' and -`ccl-decode-mule-utf-8' available). The length of the thus ensuing -comment header is prepended to the string as a 4-byte lsb int." - (let* ((title (pop comment-list)) - (value (pop comment-list))) - (setq title (concat title "=" - (oggc-encode-utf-8 value))) - (concat (oggc-int-to-lsb-bytes (length title) 4) - title))) - -(defun oggc-construct-vendor (vendor) - "Construct a vendor string from VENDOR." - (concat (oggc-int-to-lsb-bytes (length vendor) 4) - vendor)) - -;;; FIXME: This doesn't work!! -;;; Somehow, we need to modify one of the code-book headers to make -;;; note of the fact that the comment has changed. I can't see in -;;; the spec what needs to be done. -;;; This doesn't work even for the case where we don't change the -;;; length of the comment, just one character, e.g. tracknumber=1 to -;;; tracknumber=2. -(defun oggc-write-comments (file comments) - "Write COMMENTS to FILE. - -COMMENTS should be as for `oggc-construct-comment-string' (q.v.)." - (with-temp-buffer - ;; dog slow for large files. - ;; an alternative would be to use head/tail/cut as needed to - ;; split the file up and put it back together again. - (insert-file-contents-literally file) - (when (oggc-valid-ogg-stream-p) - (when (oggc-comment-exists-p) - (let ((vendor (save-excursion (oggc-read-vendor)))) - (delete-region (point) (progn (oggc-read-comments (point)) - (point))) - (insert (oggc-construct-vendor vendor) - (oggc-construct-comment-string comments)))) - (write-region nil nil file)))) - -(defun oggc-construct-comment-string (comments) - "Construct a string off Ogg-Vorbis comment headers from COMMENTS. - -COMMENTS should be an alist of the form: - ((TITLE-1 VALUE-1) - (TITLE-2 VALUE-2))" - (concat (oggc-int-to-lsb-bytes (length comments) 4) - (mapconcat #'oggc-construct-comment-field comments ""))) - -(defun oggc-read-vendor () - "Read an Ogg-Vorbis vendor string from the current buffer." - (let ((length (oggc-bytes-to-lsb-int 4))) - (oggc-read-string length))) - -(defun oggc-read-comments (pos) - "Read Ogg-Vorbis comments, starting POS bytes from `point-min'." - (goto-char pos) - (let ((vendor (oggc-read-vendor)) - (length (oggc-bytes-to-lsb-int 4)) - comments) - (loop repeat length - for this-length = (oggc-bytes-to-lsb-int 4) - for c = (oggc-read-string this-length) do - (push (oggc-split-comment c) comments)) - (list vendor (nreverse comments)))) - -(defun oggc-read-header (file) - "Read an Ogg-Vorbis header from FILE." - (with-part-of-file (file 0 - ;; Lets hope that the comments - ;; aren't more than 28KB long. - (* 1024 28)) - (when (oggc-valid-ogg-stream-p) - (aif (oggc-comment-exists-p) - (oggc-read-comments it))))) - -(defun oggc-pretty-print-header (header) - "Print Ogg HEADER readably in a temporary buffer." - (let ((vendor (car header)) - (comments (cadr header))) - (switch-to-buffer (get-buffer-create "*comments*")) - (erase-buffer) - (insert "Vendor: "vendor "\n") - (mapc #'(lambda (s) - (insert (car s) ": " (cadr s) "\n")) - comments))) - -;;;###autoload -(defun oggc-show-header (file) - "Show a pretty printed representation of the Ogg Comments in FILE." - (interactive "FFile: ") - (oggc-pretty-print-header (oggc-read-header file))) - -(provide 'ogg-comment) - -;;; ogg-comment.el ends here diff --git a/tq.el b/tq.el deleted file mode 100644 index 8daa9a2..0000000 --- a/tq.el +++ /dev/null @@ -1,172 +0,0 @@ -;;; tq.el --- utility to maintain a transaction queue - -;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. - -;; Author: Scott Draves -;; Maintainer: FSF -;; Adapted-By: ESR -;; Keywords: extensions - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This file manages receiving a stream asynchronously, parsing it -;; into transactions, and then calling the associated handler function -;; upon the completion of each transaction. - -;; Our basic structure is the queue/process/buffer triple. Each entry -;; of the queue part is a list of question, regexp, closure, and -;; function that is consed to the last element. - -;; A transaction queue may be created by calling `tq-create'. - -;; A request may be added to the queue by calling `tq-enqueue'. If -;; the `delay-question' argument is non-nil, we will wait to send the -;; question to the process until it has finished sending other input. -;; Otherwise, once a request is enqueued, we send the given question -;; immediately to the process. - -;; We then buffer bytes from the process until we see the regexp that -;; was provided in the call to `tq-enqueue'. Then we call the -;; provided function with the closure and the collected bytes. If we -;; have indicated that the question from the next transaction was not -;; sent immediately, send it at this point, awaiting the response. - -;;; Code: - -;;; Accessors - -;; This part looks like (queue . (process . buffer)) -(defun tq-queue (tq) (car tq)) -(defun tq-process (tq) (car (cdr tq))) -(defun tq-buffer (tq) (cdr (cdr tq))) - -;; The structure of `queue' is as follows -;; ((question regexp closure . fn) -;; ) -;; question: string to send to the process -(defun tq-queue-head-question (tq) (car (car (tq-queue tq)))) -;; regexp: regular expression that matches the end of a response from -;; the process -(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) -;; closure: additional data to pass to the function -(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) -;; fn: function to call upon receiving a complete response from the -;; process -(defun tq-queue-head-fn (tq) (cdr (cdr (cdr (car (tq-queue tq)))))) - -;; Determine whether queue is empty -(defun tq-queue-empty (tq) (not (tq-queue tq))) - -;;; Core functionality - -;;;###autoload -(defun tq-create (process) - "Create and return a transaction queue communicating with PROCESS. -PROCESS should be a subprocess capable of sending and receiving -streams of bytes. It may be a local process, or it may be connected -to a tcp server on another machine." - (let ((tq (cons nil (cons process - (generate-new-buffer - (concat " tq-temp-" - (process-name process))))))) - (set-process-filter process - `(lambda (proc string) - (tq-filter ',tq string))) - tq)) - -(defun tq-queue-add (tq question re closure fn) - (setcar tq (nconc (tq-queue tq) - (cons (cons question (cons re (cons closure fn))) nil))) - 'ok) - -(defun tq-queue-pop (tq) - (setcar tq (cdr (car tq))) - (let ((question (tq-queue-head-question tq))) - (condition-case nil - (process-send-string (tq-process tq) question) - (error nil))) - (null (car tq))) - -(defun tq-enqueue (tq question regexp closure fn &optional delay-question) - "Add a transaction to transaction queue TQ. -This sends the string QUESTION to the process that TQ communicates with. - -When the corresponding answer comes back, we call FN with two -arguments: CLOSURE, which may contain additional data that FN -needs, and the answer to the question. - -REGEXP is a regular expression to match the entire answer; -that's how we tell where the answer ends. - -If DELAY-QUESTION is non-nil, delay sending this question until -the process has finished replying to any previous questions. -This produces more reliable results with some processes." - (let ((sendp (or (not delay-question) - (not (tq-queue tq))))) - (tq-queue-add tq (unless sendp question) regexp closure fn) - (when sendp - (process-send-string (tq-process tq) question)))) - -(defun tq-close (tq) - "Shut down transaction queue TQ, terminating the process." - (delete-process (tq-process tq)) - (kill-buffer (tq-buffer tq))) - -(defun tq-filter (tq string) - "Append STRING to the TQ's buffer; then process the new data." - (let ((buffer (tq-buffer tq))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (goto-char (point-max)) - (insert string) - (tq-process-buffer tq))))) - -(defun tq-process-buffer (tq) - "Check TQ's buffer for the regexp at the head of the queue." - (let ((buffer (tq-buffer tq))) - (when (buffer-live-p buffer) - (set-buffer buffer) - (if (= 0 (buffer-size)) () - (if (tq-queue-empty tq) - (let ((buf (generate-new-buffer "*spurious*"))) - (copy-to-buffer buf (point-min) (point-max)) - (delete-region (point-min) (point)) - (pop-to-buffer buf nil) - (error "Spurious communication from process %s, see buffer %s" - (process-name (tq-process tq)) - (buffer-name buf))) - (goto-char (point-min)) - (if (re-search-forward (tq-queue-head-regexp tq) nil t) - (let ((answer (buffer-substring (point-min) (point)))) - (delete-region (point-min) (point)) - (unwind-protect - (condition-case nil - (funcall (tq-queue-head-fn tq) - (tq-queue-head-closure tq) - answer) - (error nil)) - (tq-queue-pop tq)) - (tq-process-buffer tq)))))))) - -(provide 'tq) - -;;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79 -;;; tq.el ends here -- cgit v1.2.3