X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e2ae1c5a40e2802fcd9f5ee26b4906be97c8b878..f2536958ec711b50a0cf8714defb921193ea8ae4:/lisp/mpc.el diff --git a/lisp/mpc.el b/lisp/mpc.el index 76c08dbcbe..20e4bc85d8 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,6 +1,6 @@ ;;; 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 ;; 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. @@ -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)) @@ -800,6 +826,9 @@ The songs are returned as alists." (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." @@ -903,8 +932,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))) @@ -995,27 +1029,29 @@ 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 (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'. @@ -1072,8 +1108,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) @@ -1092,11 +1127,29 @@ 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" '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])) @@ -1140,10 +1193,9 @@ 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) (if (boundp 'tool-bar-map) ; not if --without-x (setq-local tool-bar-map mpc-tool-bar-map)) (setq-local truncate-lines t)) @@ -1246,7 +1298,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))) @@ -1545,7 +1597,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)))))) @@ -1643,7 +1695,7 @@ Return non-nil if a selection was deactivated." (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)) @@ -1751,7 +1803,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)))) @@ -1807,7 +1859,8 @@ A value of t means the main playlist.") (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) @@ -1865,7 +1918,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)) @@ -1943,7 +1995,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)) @@ -2313,6 +2365,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) @@ -2330,6 +2406,22 @@ This is used so that they can be compared with `eq', which is needed for (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) @@ -2630,6 +2722,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))