;;; mpc.el --- A client for the Music Player Daemon -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: multimedia
;; - visual feedback for drag'n'drop
;; - display/set `repeat' and `random' state (and maybe also `crossfade').
;; - allow multiple *mpc* sessions in the same Emacs to control different mpds.
-;; - look for .folder.png (freedesktop) or folder.jpg (XP) as well.
;; - fetch album covers and lyrics from the web?
;; - improve MPC-Status: better volume control, add a way to show/hide the
;; rest, plus add the buttons currently in the toolbar.
;; UI-commands : mpc-
;; internal : mpc--
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
(defgroup mpc ()
"Client for the Music Player Daemon (mpd)."
(goto-char (point-max))
(insert-before-markers ;So it scrolls.
(replace-regexp-in-string "\n" "\n "
- (apply 'format format args))
+ (apply #'format-message format args))
"\n"))))
(defun mpc--proc-filter (proc string)
(defun mpc--proc-connect (host)
(let ((port 6600)
+ local
pass)
(when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'"
(if (string-match "[^[:digit:]]" v)
(string-to-number v)
v)))))
+ (when (file-name-absolute-p host)
+ ;; Expand file name because `file-name-absolute-p'
+ ;; considers paths beginning with "~" as absolute
+ (setq host (expand-file-name host))
+ (setq local t))
(mpc--debug "Connecting to %s:%s..." host port)
(with-current-buffer (get-buffer-create (format " *mpc-%s:%s*" host port))
(let* ((coding-system-for-read 'utf-8-unix)
(coding-system-for-write 'utf-8-unix)
(proc (condition-case err
- (open-network-stream "MPC" (current-buffer) host port)
+ (make-network-process :name "MPC" :buffer (current-buffer)
+ :host (unless local host)
+ :service (if local host port)
+ :family (if local 'local))
(error (user-error (error-message-string err))))))
(when (processp mpc-proc)
;; Inherit the properties of the previous connection.
;; (setq mpc-queue-back nil mpc-queue nil)
)
+(defun mpc-cmd-consume (&optional arg)
+ "Set consume mode state."
+ (mpc-proc-cmd (list "consume" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-random (&optional arg)
+ "Set random (shuffle) mode state."
+ (mpc-proc-cmd (list "random" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-repeat (&optional arg)
+ "Set repeat mode state."
+ (mpc-proc-cmd (list "repeat" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-single (&optional arg)
+ "Set single mode state."
+ (mpc-proc-cmd (list "single" arg) #'mpc-status-refresh))
+
(defun mpc-cmd-pause (&optional arg callback)
"Pause or resume playback of the queue of songs."
(let ((cb callback))
(mpc-proc-cmd "play")
(mpc-status-refresh))
+(defun mpc-cmd-seekcur (time)
+ (mpc-proc-cmd (list "seekcur" time) #'mpc-status-refresh))
+
(defun mpc-cmd-add (files &optional playlist)
"Add the songs FILES to PLAYLIST.
If PLAYLIST is t or nil or missing, use the main playlist."
(defun mpc-file-local-copy (file)
;; Try to set mpc-mpd-music-directory.
(when (and (null mpc-mpd-music-directory)
- (string-match "\\`localhost" mpc-host))
- (let ((files '("~/.mpdconf" "/etc/mpd.conf"))
+ (or (string-match "\\`localhost" mpc-host)
+ (file-name-absolute-p mpc-host)))
+ (let ((files `(,(let ((xdg (getenv "XDG_CONFIG_HOME")))
+ (concat (if (and xdg (file-name-absolute-p xdg))
+ xdg "~/.config")
+ "/mpd/mpd.conf"))
+ "~/.mpdconf" "~/.mpd/mpd.conf" "/etc/mpd.conf"))
file)
(while (and files (not file))
(if (file-exists-p (car files)) (setq file (car files)))
(substring time (match-end 0))
time)))))
(`Cover
- (let* ((dir (file-name-directory (cdr (assq 'file info))))
- (cover (concat dir "cover.jpg"))
- (file (with-demoted-errors "MPC: %s"
- (mpc-file-local-copy cover)))
- image)
+ (let ((dir (file-name-directory (cdr (assq 'file info)))))
;; (debug)
(push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred)
- (if (null file)
- ;; Make sure we return something on which we can
- ;; place the `mpc-pred' property, as
- ;; a negative-cache. We could also use
- ;; a default cover.
- (progn (setq size nil) " ")
- (if (null size) (setq image (create-image file))
- (let ((tempfile (make-temp-file "mpc" nil ".jpg")))
- (call-process "convert" nil nil nil
- "-scale" size file tempfile)
- (setq image (create-image tempfile))
- (mpc-tempfiles-add image tempfile)))
- (setq size nil)
- (propertize dir 'display image))))
+ (if-let ((covers '(".folder.png" "cover.jpg" "folder.jpg"))
+ (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir))
+ if (member (downcase file) covers)
+ return (concat dir file)))
+ (file (with-demoted-errors "MPC: %s"
+ (mpc-file-local-copy cover))))
+ (let (image)
+ (if (null size) (setq image (create-image file))
+ (let ((tempfile (make-temp-file "mpc" nil ".jpg")))
+ (call-process "convert" nil nil nil
+ "-scale" size file tempfile)
+ (setq image (create-image tempfile))
+ (mpc-tempfiles-add image tempfile)))
+ (setq size nil)
+ (propertize dir 'display image))
+ ;; Make sure we return something on which we can
+ ;; place the `mpc-pred' property, as
+ ;; a negative-cache. We could also use
+ ;; a default cover.
+ (progn (setq size nil) " "))))
(_ (let ((val (cdr (assq tag info))))
;; For Streaming URLs, there's no other info
;; than the URL in `file'. Pretend it's in `Title'.
;;; The actual UI code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mpc-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
+ (let ((map (make-sparse-keymap)))
;; (define-key map "\e" 'mpc-stop)
(define-key map "q" 'mpc-quit)
(define-key map "\r" 'mpc-select)
;; is applied elsewhere :-(
;; (define-key map [(double mouse-2)] 'mpc-play-at-point)
(define-key map "p" 'mpc-pause)
+ (define-key map "s" 'mpc-toggle-play)
+ (define-key map ">" 'mpc-next)
+ (define-key map "<" 'mpc-prev)
+ (define-key map "g" 'mpc-seek-current)
map))
(easy-menu-define mpc-mode-menu mpc-mode-map
"Menu for MPC.el."
'("MPC.el"
+ ["Play/Pause" mpc-toggle-play] ;FIXME: Add one of ⏯/▶/⏸ in there?
+ ["Next Track" mpc-next] ;FIXME: Add ⇥ there?
+ ["Previous Track" mpc-prev] ;FIXME: Add ⇤ there?
+ ["Seek Within Track" mpc-seek-current]
+ "--"
+ ["Repeat Playlist" mpc-toggle-repeat :style toggle
+ :selected (member '(repeat . "1") mpc-status)]
+ ["Shuffle Playlist" mpc-toggle-shuffle :style toggle
+ :selected (member '(random . "1") mpc-status)]
+ ["Repeat Single Track" mpc-toggle-single :style toggle
+ :selected (member '(single . "1") mpc-status)]
+ ["Consume Mode" mpc-toggle-consume :style toggle
+ :selected (member '(consume . "1") mpc-status)]
+ "--"
["Add new browser" mpc-tagbrowser]
["Update DB" mpc-update]
["Quit" mpc-quit]))
:help "Append to the playlist")
map))
-(define-derived-mode mpc-mode fundamental-mode "MPC"
+(define-derived-mode mpc-mode special-mode "MPC"
"Major mode for the features common to all buffers of MPC."
(buffer-disable-undo)
- (setq buffer-read-only t)
(if (boundp 'tool-bar-map) ; not if --without-x
(setq-local tool-bar-map mpc-tool-bar-map))
(setq-local truncate-lines t))
(let ((ol (make-overlay
(line-beginning-position) (line-beginning-position 2))))
(overlay-put ol 'mpc-select t)
- (overlay-put ol 'face 'region)
+ (overlay-put ol 'face 'highlight)
(overlay-put ol 'evaporate t)
(push ol mpc-select)))
(move-overlay mpc-tagbrowser-all-ol
(point) (line-beginning-position 2))
(let ((ol (make-overlay (point) (line-beginning-position 2))))
- (overlay-put ol 'face 'region)
+ (overlay-put ol 'face 'highlight)
(overlay-put ol 'evaporate t)
(setq-local mpc-tagbrowser-all-ol ol))))))
(when (equal (sort (copy-sequence active) #'string-lessp)
(sort (copy-sequence selection) #'string-lessp))
(setq active 'all)))
-
+
;; FIXME: This `mpc-sort' takes a lot of time. Maybe we should
;; be more clever and presume the buffer is mostly sorted already.
(mpc-sort (if (listp active) active))
(completing-read "Rename playlist: "
(mpc-cmd-list 'Playlist)
nil 'require-match)))
- (newname (read-string (format "Rename '%s' to: " oldname))))
+ (newname (read-string (format-message "Rename `%s' to: " oldname))))
(if (zerop (length newname))
(error "Aborted")
(list oldname newname))))
(mpc-volume-widget
(string-to-number (cdr (assq 'volume mpc-status)))))
(let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)))
- (when status-buf (with-current-buffer status-buf (force-mode-line-update)))))
+ (when (buffer-live-p status-buf)
+ (with-current-buffer status-buf (force-mode-line-update)))))
(defvar mpc-volume-step 5)
(defvar mpc-songs-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map mpc-mode-map)
(define-key map [remap mpc-select] 'mpc-songs-jump-to)
map))
;; I punt on it and just use file-name sorting, which does the
;; right thing if your library is properly arranged.
(dolist (song (if dontsort active
- (sort active
+ (sort (copy-sequence active)
(lambda (song1 song2)
(let ((cmp (mpc-compare-strings
(cdr (assq 'file song1))
(mpc-status-stop)
(if proc (delete-process proc))))
+(defun mpc-toggle-consume ()
+ "Toggle consume mode: removing played songs from the playlist."
+ (interactive)
+ (mpc-cmd-consume
+ (if (string= "0" (cdr (assq 'consume (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-repeat ()
+ "Toggle repeat mode."
+ (interactive)
+ (mpc-cmd-repeat
+ (if (string= "0" (cdr (assq 'repeat (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-single ()
+ "Toggle single mode."
+ (interactive)
+ (mpc-cmd-single
+ (if (string= "0" (cdr (assq 'single (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-shuffle ()
+ "Toggle shuffling of the playlist (random mode)."
+ (interactive)
+ (mpc-cmd-random
+ (if (string= "0" (cdr (assq 'random (mpc-cmd-status)))) "1" "0")))
+
(defun mpc-stop ()
"Stop playing the current queue of songs."
(interactive)
(interactive)
(mpc-cmd-pause "0"))
+(defun mpc-seek-current (pos)
+ "Seek within current track."
+ (interactive
+ (list (read-string "Position to go ([+-]seconds): ")))
+ (mpc-cmd-seekcur pos))
+
+(defun mpc-toggle-play ()
+ "Toggle between play and pause.
+If stopped, start playback."
+ (interactive)
+ (if (member (cdr (assq 'state (mpc-cmd-status))) '("stop"))
+ (mpc-cmd-play)
+ (if (member (cdr (assq 'state (mpc-cmd-status))) '("pause"))
+ (mpc-resume)
+ (mpc-pause))))
+
(defun mpc-play ()
"Start playing whatever is selected."
(interactive)
(interactive
(progn
(if current-prefix-arg
+ ;; FIXME: We should provide some completion here, especially for the
+ ;; case where the user specifies a local socket/file name.
(setq mpc-host (read-string "MPD host and port: " nil nil mpc-host)))
nil))
(let* ((song-buf (mpc-songs-buf))