diff options
Diffstat (limited to 'lisp/mpc.el')
| -rw-r--r-- | lisp/mpc.el | 228 |
1 files changed, 166 insertions, 62 deletions
diff --git a/lisp/mpc.el b/lisp/mpc.el index 825eb3c05d4..af1aac93f14 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,6 +1,6 @@ -;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- +;;; mpc.el --- A client for the Music Player Daemon -*- lexical-binding: t -*- -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: multimedia @@ -44,7 +44,6 @@ ;; - 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. @@ -92,7 +91,9 @@ ;; 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)." @@ -217,7 +218,7 @@ defaults to 6600 and HOST defaults to localhost." (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) @@ -253,6 +254,7 @@ defaults to 6600 and HOST defaults to localhost." (defun mpc--proc-connect (host) (let ((port 6600) + local pass) (when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'" @@ -267,6 +269,11 @@ defaults to 6600 and HOST defaults to localhost." (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)) @@ -279,7 +286,10 @@ defaults to 6600 and HOST defaults to localhost." (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. @@ -491,10 +501,13 @@ to call FUN for any change whatsoever.") (cancel-timer mpc--status-timer) (setq mpc--status-timer nil))) (defun mpc--status-timer-run () - (condition-case err - (when (process-get (mpc-proc) 'ready) - (with-local-quit (mpc-status-refresh))) - (error (message "MPC: %s" err)))) + (with-demoted-errors "MPC: %S" + (when (process-get (mpc-proc) 'ready) + (let* ((buf (mpc-proc-buffer (mpc-proc) 'status)) + (win (get-buffer-window buf t))) + (if (not win) + (mpc--status-timer-stop) + (with-local-quit (mpc-status-refresh))))))) (defvar mpc--status-idle-timer nil) (defun mpc--status-idle-timer-start () @@ -519,11 +532,8 @@ to call FUN for any change whatsoever.") ;; client starts playback, we may get a chance to notice it. (run-with-idle-timer 10 t 'mpc--status-idle-timer-run)))) (defun mpc--status-idle-timer-run () - (when (process-get (mpc-proc) 'ready) - (condition-case err - (with-local-quit (mpc-status-refresh)) - (error (message "MPC: %s" err)))) - (mpc--status-timer-start)) + (mpc--status-timer-start) + (mpc--status-timer-run)) (defun mpc--status-timers-refresh () "Start/stop the timers according to whether a song is playing." @@ -786,6 +796,22 @@ The songs are returned as alists." ;; (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)) @@ -891,9 +917,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." :type '(choice (const nil) directory)) (defcustom mpc-data-directory - (if (and (not (file-directory-p "~/.mpc")) - (file-directory-p "~/.emacs.d")) - "~/.emacs.d/mpc" "~/.mpc") + (locate-user-emacs-file "mpc" ".mpc") "Directory where MPC.el stores auxiliary data." :type 'directory) @@ -905,8 +929,13 @@ 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))) @@ -997,35 +1026,42 @@ If PLAYLIST is t or nil or missing, use the main playlist." (substring time (match-end 0)) time))))) (`Cover - (let* ((dir (file-name-directory (cdr (assq 'file info)))) - (cover (concat dir "cover.jpg")) - (file (condition-case err - (mpc-file-local-copy cover) - (error (message "MPC: %s" err)))) - image) + (let ((dir (file-name-directory + (mpc-file-local-copy (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 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'. (when (and (null val) (eq tag 'Title)) (setq val (cdr (assq 'file info)))) (push `(equal ',val (cdr (assq ',tag info))) pred) - val))))) + (cond + ((not (and (eq tag 'Date) (stringp val))) val) + ;; For "date", only keep the year! + ((string-match "[0-9]\\{4\\}" val) + (match-string 0 val)) + (t val))))))) (space (when size (setq size (string-to-number size)) (propertize " " 'display @@ -1070,8 +1106,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." ;;; 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) @@ -1090,11 +1125,28 @@ If PLAYLIST is t or nil or missing, use the main playlist." ;; 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" nil) 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? + "--" + ["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])) @@ -1138,11 +1190,11 @@ If PLAYLIST is t or nil or missing, use the main playlist." :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) - (setq-local tool-bar-map mpc-tool-bar-map) + (if (boundp 'tool-bar-map) ; not if --without-x + (setq-local tool-bar-map mpc-tool-bar-map)) (setq-local truncate-lines t)) ;;; The mpc-status-mode buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1243,7 +1295,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (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))) @@ -1542,7 +1594,7 @@ when constructing the set of constraints." (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)))))) @@ -1619,7 +1671,7 @@ Return non-nil if a selection was deactivated." (setq active (if (listp active) (mpc-intersection active vals) vals)))) - (when (and (listp active)) + (when (listp active) ;; Remove the selections if they are all in conflict with ;; other constraints. (let ((deactivate t)) @@ -1633,7 +1685,13 @@ Return non-nil if a selection was deactivated." (setq selection nil) (mapc 'delete-overlay mpc-select) (setq mpc-select nil) - (mpc-tagbrowser-all-select))))) + (mpc-tagbrowser-all-select)))) + + ;; Don't bother splitting the "active" elements to the first part if + ;; they're the same as the selection. + (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. @@ -1742,7 +1800,7 @@ A value of t means the main playlist.") (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)))) @@ -1796,7 +1854,10 @@ A value of t means the main playlist.") ;; Maintain the volume. (setq mpc-volume (mpc-volume-widget - (string-to-number (cdr (assq 'volume mpc-status)))))) + (string-to-number (cdr (assq 'volume mpc-status))))) + (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) + (when (buffer-live-p status-buf) + (with-current-buffer status-buf (force-mode-line-update))))) (defvar mpc-volume-step 5) @@ -1811,9 +1872,14 @@ A value of t means the main playlist.") (char-after (posn-point posn)))) '(?◁ ?<)) (- mpc-volume-step) mpc-volume-step)) - (newvol (+ (string-to-number (cdr (assq 'volume mpc-status))) diff))) - (mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh) - (message "Set MPD volume to %s%%" newvol))) + (curvol (string-to-number (cdr (assq 'volume mpc-status)))) + (newvol (max 0 (min 100 (+ curvol diff))))) + (if (= newvol curvol) + (progn + (message "MPD volume already at %s%%" newvol) + (ding)) + (mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh) + (message "Set MPD volume to %s%%" newvol)))) (defun mpc-volume-widget (vol &optional size) (unless size (setq size 12.5)) @@ -1849,7 +1915,6 @@ A value of t means the main playlist.") (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)) @@ -1861,7 +1926,7 @@ This is used so that they can be compared with `eq', which is needed for `text-property-any'.") (defun mpc-songs-hashcons (name) (or (gethash name mpc-songs-hashcons) (puthash name name mpc-songs-hashcons))) -(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %10{Date}" +(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %5{Date}" "Format used to display each song in the list of songs." :type 'string) @@ -1927,7 +1992,7 @@ This is used so that they can be compared with `eq', which is needed for ;; 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)) @@ -2011,14 +2076,16 @@ This is used so that they can be compared with `eq', which is needed for posn)))) (let* ((plbuf (mpc-proc-cmd "playlist")) (re (if song-file - (concat "^\\([0-9]+\\):" (regexp-quote song-file) "$"))) + ;; Newer MPCs apparently include "file: " in the buffer. + (concat "^\\([0-9]+\\):\\(?:file: \\)?" + (regexp-quote song-file) "$"))) (sn (with-current-buffer plbuf (goto-char (point-min)) (when (and re (re-search-forward re nil t)) (match-string 1))))) (cond ((null re) (posn-set-point posn)) - ((null sn) (error "This song is not in the playlist")) + ((null sn) (user-error "This song is not in the playlist")) ((null (with-current-buffer plbuf (re-search-forward re nil t))) ;; song-file only appears once in the playlist: no ambiguity, ;; we're good to go! @@ -2295,6 +2362,30 @@ This is used so that they can be compared with `eq', which is needed for (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) @@ -2312,6 +2403,16 @@ This is used so that they can be compared with `eq', which is needed for (interactive) (mpc-cmd-pause "0")) +(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) @@ -2328,7 +2429,7 @@ This is used so that they can be compared with `eq', which is needed for (if (mpc-playlist-add) (if (member (cdr (assq 'state (mpc-cmd-status))) '("stop")) (mpc-cmd-play)) - (error "Don't know what to play")))) + (user-error "Don't know what to play")))) (defun mpc-next () "Jump to the next song in the queue." @@ -2592,7 +2693,8 @@ This is used so that they can be compared with `eq', which is needed for (mpc-cmd-move (let ((poss '())) (dotimes (i (length songs)) (push (+ i (length pl)) poss)) - (nreverse poss)) dest-pos mpc-songs-playlist) + (nreverse poss)) + dest-pos mpc-songs-playlist) (message "Added %d songs" (length songs))))) (mpc-songs-refresh)) (t @@ -2611,6 +2713,8 @@ This is used so that they can be compared with `eq', which is needed for (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)) |